From add62ef56a49f1a6008d131450d192ad08033afa Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Tue, 21 Mar 2023 17:09:25 +0100 Subject: [PATCH] Remove legacy function LABAD See https://github.com/Reference-LAPACK/lapack/issues/96 --- SRC/DEPRECATED/cgelsx.f | 3 +-- SRC/DEPRECATED/dgelsx.f | 1 - SRC/DEPRECATED/sgelsx.f | 3 +-- SRC/DEPRECATED/zgelsx.f | 1 - SRC/cgees.f | 3 +-- SRC/cgeesx.f | 3 +-- SRC/cgeev.f | 3 +-- SRC/cgeevx.f | 3 +-- SRC/cgels.f | 3 +-- SRC/cgelsd.f | 3 +-- SRC/cgelss.f | 4 +--- SRC/cgelst.f | 3 +-- SRC/cgelsy.f | 3 +-- SRC/cgesc2.f | 3 +-- SRC/cgetc2.f | 3 +-- SRC/cgetsls.f | 3 +-- SRC/cgges.f | 4 +--- SRC/cgges3.f | 4 +--- SRC/cggesx.f | 4 +--- SRC/cggev.f | 4 +--- SRC/cggev3.f | 4 +--- SRC/cggevx.f | 3 +-- SRC/clahqr.f | 3 +-- SRC/claqr2.f | 3 +-- SRC/claqr3.f | 3 +-- SRC/claqr5.f | 4 +--- SRC/claqz0.f | 3 +-- SRC/claqz2.f | 3 +-- SRC/claqz3.f | 4 +--- SRC/clatps.f | 3 +-- SRC/csrscl.f | 3 +-- SRC/ctgevc.f | 3 +-- SRC/ctgsna.f | 3 +-- SRC/ctrevc.f | 3 +-- SRC/ctrevc3.f | 3 +-- SRC/ctrsna.f | 4 +--- SRC/ctrsyl.f | 3 +-- SRC/dgees.f | 3 +-- SRC/dgeesx.f | 3 +-- SRC/dgeev.f | 6 ++---- SRC/dgeevx.f | 7 +++---- SRC/dgels.f | 3 +-- SRC/dgelsd.f | 3 +-- SRC/dgelss.f | 3 +-- SRC/dgelst.f | 5 ++--- SRC/dgelsy.f | 3 +-- SRC/dgesc2.f | 3 +-- SRC/dgetc2.f | 3 +-- SRC/dgetsls.f | 3 +-- SRC/dgges.f | 6 ++---- SRC/dgges3.f | 6 ++---- SRC/dggesx.f | 6 ++---- SRC/dggev.f | 6 ++---- SRC/dggev3.f | 6 ++---- SRC/dggevx.f | 7 +++---- SRC/dlabad.f | 26 ++++++++++---------------- SRC/dlahqr.f | 3 +-- SRC/dlaqr2.f | 3 +-- SRC/dlaqr3.f | 6 ++---- SRC/dlaqr5.f | 4 +--- SRC/dlaqz0.f | 3 +-- SRC/dlaqz3.f | 3 +-- SRC/drscl.f | 3 +-- SRC/dtgevc.f | 3 +-- SRC/dtrevc.f | 4 +--- SRC/dtrevc3.f | 3 +-- SRC/dtrsna.f | 3 +-- SRC/dtrsyl.f | 3 +-- SRC/sgees.f | 5 ++--- SRC/sgeesx.f | 3 +-- SRC/sgeev.f | 6 ++---- SRC/sgeevx.f | 3 +-- SRC/sgels.f | 3 +-- SRC/sgelsd.f | 5 ++--- SRC/sgelss.f | 3 +-- SRC/sgelst.f | 3 +-- SRC/sgelsy.f | 3 +-- SRC/sgesc2.f | 3 +-- SRC/sgetc2.f | 3 +-- SRC/sgetsls.f | 3 +-- SRC/sgges.f | 6 ++---- SRC/sgges3.f | 6 ++---- SRC/sggesx.f | 6 ++---- SRC/sggev.f | 6 ++---- SRC/sggev3.f | 6 ++---- SRC/sggevx.f | 7 +++---- SRC/slabad.f | 25 +++++++++---------------- SRC/slahqr.f | 3 +-- SRC/slaqr2.f | 3 +-- SRC/slaqr3.f | 6 ++---- SRC/slaqr5.f | 4 +--- SRC/slaqz0.f | 3 +-- SRC/slaqz3.f | 3 +-- SRC/srscl.f | 3 +-- SRC/stgevc.f | 3 +-- SRC/strevc.f | 4 +--- SRC/strevc3.f | 3 +-- SRC/strsna.f | 3 +-- SRC/strsyl.f | 3 +-- SRC/zdrscl.f | 3 +-- SRC/zgees.f | 3 +-- SRC/zgeesx.f | 5 ++--- SRC/zgeev.f | 5 ++--- SRC/zgeevx.f | 7 +++---- SRC/zgels.f | 3 +-- SRC/zgelsd.f | 7 +++---- SRC/zgelss.f | 8 +++----- SRC/zgelst.f | 5 ++--- SRC/zgelsy.f | 3 +-- SRC/zgesc2.f | 3 +-- SRC/zgetc2.f | 3 +-- SRC/zgetsls.f | 3 +-- SRC/zgges.f | 6 ++---- SRC/zgges3.f | 6 ++---- SRC/zggesx.f | 6 ++---- SRC/zggev.f | 6 ++---- SRC/zggev3.f | 6 ++---- SRC/zggevx.f | 7 +++---- SRC/zlahqr.f | 3 +-- SRC/zlaqr2.f | 3 +-- SRC/zlaqr3.f | 5 ++--- SRC/zlaqr5.f | 4 +--- SRC/zlaqz0.f | 3 +-- SRC/zlaqz2.f | 3 +-- SRC/zlaqz3.f | 4 +--- SRC/zlatps.f | 3 +-- SRC/ztgevc.f | 3 +-- SRC/ztgsna.f | 3 +-- SRC/ztrevc.f | 3 +-- SRC/ztrevc3.f | 3 +-- SRC/ztrsna.f | 4 +--- SRC/ztrsyl.f | 3 +-- 132 files changed, 187 insertions(+), 366 deletions(-) diff --git a/SRC/DEPRECATED/cgelsx.f b/SRC/DEPRECATED/cgelsx.f index a5c7c9ed89..54c7f58b7d 100644 --- a/SRC/DEPRECATED/cgelsx.f +++ b/SRC/DEPRECATED/cgelsx.f @@ -216,7 +216,7 @@ SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * .. * .. External Subroutines .. EXTERNAL CGEQPF, CLAIC1, CLASCL, CLASET, CLATZM, CTRSM, - $ CTZRQF, CUNM2R, SLABAD, XERBLA + $ CTZRQF, CUNM2R, XERBLA * .. * .. External Functions .. REAL CLANGE, SLAMCH @@ -262,7 +262,6 @@ SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max elements outside range [SMLNUM,BIGNUM] * diff --git a/SRC/DEPRECATED/dgelsx.f b/SRC/DEPRECATED/dgelsx.f index 395fcb0d14..548cf67123 100644 --- a/SRC/DEPRECATED/dgelsx.f +++ b/SRC/DEPRECATED/dgelsx.f @@ -251,7 +251,6 @@ SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max elements outside range [SMLNUM,BIGNUM] * diff --git a/SRC/DEPRECATED/sgelsx.f b/SRC/DEPRECATED/sgelsx.f index 8760a02a6f..2f132399b9 100644 --- a/SRC/DEPRECATED/sgelsx.f +++ b/SRC/DEPRECATED/sgelsx.f @@ -208,7 +208,7 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, EXTERNAL SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SGEQPF, SLABAD, SLAIC1, SLASCL, SLASET, SLATZM, + EXTERNAL SGEQPF, SLAIC1, SLASCL, SLASET, SLATZM, $ SORM2R, STRSM, STZRQF, XERBLA * .. * .. Intrinsic Functions .. @@ -251,7 +251,6 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max elements outside range [SMLNUM,BIGNUM] * diff --git a/SRC/DEPRECATED/zgelsx.f b/SRC/DEPRECATED/zgelsx.f index 0482b401df..a879381968 100644 --- a/SRC/DEPRECATED/zgelsx.f +++ b/SRC/DEPRECATED/zgelsx.f @@ -262,7 +262,6 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max elements outside range [SMLNUM,BIGNUM] * diff --git a/SRC/cgees.f b/SRC/cgees.f index 71acfdba3b..ad790f0798 100644 --- a/SRC/cgees.f +++ b/SRC/cgees.f @@ -230,7 +230,7 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, - $ CLASCL, CTRSEN, CUNGHR, SLABAD, XERBLA + $ CLASCL, CTRSEN, CUNGHR, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -318,7 +318,6 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cgeesx.f b/SRC/cgeesx.f index 782e367475..ad5df2023d 100644 --- a/SRC/cgeesx.f +++ b/SRC/cgeesx.f @@ -274,7 +274,7 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, - $ CLASCL, CTRSEN, CUNGHR, SLABAD, SLASCL, XERBLA + $ CLASCL, CTRSEN, CUNGHR, SLASCL, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -376,7 +376,6 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cgeev.f b/SRC/cgeev.f index a77525ef84..a624e0bfdb 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -212,7 +212,7 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SLABAD, XERBLA, CSSCAL, CGEBAK, CGEBAL, CGEHRD, + EXTERNAL XERBLA, CSSCAL, CGEBAK, CGEBAL, CGEHRD, $ CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, CUNGHR * .. * .. External Functions .. @@ -315,7 +315,6 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cgeevx.f b/SRC/cgeevx.f index 2388f5accf..de2adcf2a5 100644 --- a/SRC/cgeevx.f +++ b/SRC/cgeevx.f @@ -323,7 +323,7 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLASCL, XERBLA, CSSCAL, CGEBAK, CGEBAL, + EXTERNAL SLASCL, XERBLA, CSSCAL, CGEBAK, CGEBAL, $ CGEHRD, CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, $ CTRSNA, CUNGHR * .. @@ -458,7 +458,6 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cgels.f b/SRC/cgels.f index fd98873406..1844c96e70 100644 --- a/SRC/cgels.f +++ b/SRC/cgels.f @@ -216,7 +216,7 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * .. * .. External Subroutines .. EXTERNAL CGELQF, CGEQRF, CLASCL, CLASET, CTRTRS, CUNMLQ, - $ CUNMQR, SLABAD, XERBLA + $ CUNMQR, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, REAL @@ -296,7 +296,6 @@ SUBROUTINE CGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/cgelsd.f b/SRC/cgelsd.f index fce4ca6e29..93b81aa438 100644 --- a/SRC/cgelsd.f +++ b/SRC/cgelsd.f @@ -255,7 +255,7 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * .. External Subroutines .. EXTERNAL CGEBRD, CGELQF, CGEQRF, CLACPY, $ CLALSD, CLASCL, CLASET, CUNMBR, - $ CUNMLQ, CUNMQR, SLABAD, SLASCL, + $ CUNMLQ, CUNMQR, SLASCL, $ SLASET, XERBLA * .. * .. External Functions .. @@ -402,7 +402,6 @@ SUBROUTINE CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, SFMIN = SLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A if max entry outside range [SMLNUM,BIGNUM]. * diff --git a/SRC/cgelss.f b/SRC/cgelss.f index da6b9092f0..538b901419 100644 --- a/SRC/cgelss.f +++ b/SRC/cgelss.f @@ -214,8 +214,7 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * .. External Subroutines .. EXTERNAL CBDSQR, CCOPY, CGEBRD, CGELQF, CGEMM, CGEMV, $ CGEQRF, CLACPY, CLASCL, CLASET, CSRSCL, CUNGBR, - $ CUNMBR, CUNMLQ, CUNMQR, SLABAD, SLASCL, SLASET, - $ XERBLA + $ CUNMBR, CUNMLQ, CUNMQR, SLASCL, SLASET, XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -388,7 +387,6 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, SFMIN = SLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/cgelst.f b/SRC/cgelst.f index 7d8e44ddf2..3ff62dde9f 100644 --- a/SRC/cgelst.f +++ b/SRC/cgelst.f @@ -228,7 +228,7 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, SLAMCH, CLANGE * .. * .. External Subroutines .. - EXTERNAL CGELQT, CGEQRT, CGEMLQT, CGEMQRT, SLABAD, + EXTERNAL CGELQT, CGEQRT, CGEMLQT, CGEMQRT, $ CLASCL, CLASET, CTRTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -311,7 +311,6 @@ SUBROUTINE CGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/cgelsy.f b/SRC/cgelsy.f index 67140f1913..b16e4231ce 100644 --- a/SRC/cgelsy.f +++ b/SRC/cgelsy.f @@ -243,7 +243,7 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEQP3, CLAIC1, CLASCL, CLASET, CTRSM, - $ CTZRZF, CUNMQR, CUNMRZ, SLABAD, XERBLA + $ CTZRZF, CUNMQR, CUNMRZ, XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -303,7 +303,6 @@ SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max entries outside range [SMLNUM,BIGNUM] * diff --git a/SRC/cgesc2.f b/SRC/cgesc2.f index 129e498d9e..ade536c5d2 100644 --- a/SRC/cgesc2.f +++ b/SRC/cgesc2.f @@ -138,7 +138,7 @@ SUBROUTINE CGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) COMPLEX TEMP * .. * .. External Subroutines .. - EXTERNAL CLASWP, CSCAL, SLABAD + EXTERNAL CLASWP, CSCAL * .. * .. External Functions .. INTEGER ICAMAX @@ -155,7 +155,6 @@ SUBROUTINE CGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Apply permutations IPIV to RHS * diff --git a/SRC/cgetc2.f b/SRC/cgetc2.f index 94267d7670..1fd40c7f9c 100644 --- a/SRC/cgetc2.f +++ b/SRC/cgetc2.f @@ -132,7 +132,7 @@ SUBROUTINE CGETC2( N, A, LDA, IPIV, JPIV, INFO ) REAL BIGNUM, EPS, SMIN, SMLNUM, XMAX * .. * .. External Subroutines .. - EXTERNAL CGERU, CSWAP, SLABAD + EXTERNAL CGERU, CSWAP * .. * .. External Functions .. REAL SLAMCH @@ -155,7 +155,6 @@ SUBROUTINE CGETC2( N, A, LDA, IPIV, JPIV, INFO ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Handle the case N=1 by itself * diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f index 8a4d022246..8429896e13 100644 --- a/SRC/cgetsls.f +++ b/SRC/cgetsls.f @@ -192,7 +192,7 @@ SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, CLANGE - EXTERNAL LSAME, SLABAD, SLAMCH, CLANGE + EXTERNAL LSAME, SLAMCH, CLANGE * .. * .. External Subroutines .. EXTERNAL CGEQR, CGEMQR, CLASCL, CLASET, @@ -297,7 +297,6 @@ SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/cgges.f b/SRC/cgges.f index c54174da49..b798ce6820 100644 --- a/SRC/cgges.f +++ b/SRC/cgges.f @@ -312,8 +312,7 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, * .. * .. External Subroutines .. EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, - $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, SLABAD, - $ XERBLA + $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -415,7 +414,6 @@ SUBROUTINE CGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cgges3.f b/SRC/cgges3.f index aac9f95103..7fdb9b0af8 100644 --- a/SRC/cgges3.f +++ b/SRC/cgges3.f @@ -310,8 +310,7 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, * .. * .. External Subroutines .. EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY, - $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, SLABAD, - $ XERBLA + $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -422,7 +421,6 @@ SUBROUTINE CGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cggesx.f b/SRC/cggesx.f index 6385a74c11..3f8740062f 100644 --- a/SRC/cggesx.f +++ b/SRC/cggesx.f @@ -373,8 +373,7 @@ SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, * .. * .. External Subroutines .. EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, - $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, SLABAD, - $ XERBLA + $ CLASCL, CLASET, CTGSEN, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -510,7 +509,6 @@ SUBROUTINE CGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cggev.f b/SRC/cggev.f index c1c28a1805..1b47e1e796 100644 --- a/SRC/cggev.f +++ b/SRC/cggev.f @@ -254,8 +254,7 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * .. * .. External Subroutines .. EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, - $ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, SLABAD, - $ XERBLA + $ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -359,7 +358,6 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, EPS = SLAMCH( 'E' )*SLAMCH( 'B' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cggev3.f b/SRC/cggev3.f index 9483ecdeb1..103c9f50ac 100644 --- a/SRC/cggev3.f +++ b/SRC/cggev3.f @@ -253,8 +253,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, * .. * .. External Subroutines .. EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY, - $ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, SLABAD, - $ XERBLA + $ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -368,7 +367,6 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, EPS = SLAMCH( 'E' )*SLAMCH( 'B' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/cggevx.f b/SRC/cggevx.f index 405c9c3b56..f74b9c0be8 100644 --- a/SRC/cggevx.f +++ b/SRC/cggevx.f @@ -416,7 +416,7 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, * .. External Subroutines .. EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY, $ CLASCL, CLASET, CTGEVC, CTGSNA, CUNGQR, CUNMQR, - $ SLABAD, SLASCL, XERBLA + $ SLASCL, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -545,7 +545,6 @@ SUBROUTINE CGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/clahqr.f b/SRC/clahqr.f index dbd848e2f3..5fa29d685d 100644 --- a/SRC/clahqr.f +++ b/SRC/clahqr.f @@ -236,7 +236,7 @@ SUBROUTINE CLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, EXTERNAL CLADIV, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CLARFG, CSCAL, SLABAD + EXTERNAL CCOPY, CLARFG, CSCAL * .. * .. Statement Functions .. REAL CABS1 @@ -298,7 +298,6 @@ SUBROUTINE CLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( NH ) / ULP ) * diff --git a/SRC/claqr2.f b/SRC/claqr2.f index 1695fbe5bd..628a7a5437 100644 --- a/SRC/claqr2.f +++ b/SRC/claqr2.f @@ -302,7 +302,7 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLARF, - $ CLARFG, CLASET, CTREXC, CUNMHR, SLABAD + $ CLARFG, CLASET, CTREXC, CUNMHR * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL @@ -360,7 +360,6 @@ SUBROUTINE CLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N ) / ULP ) * diff --git a/SRC/claqr3.f b/SRC/claqr3.f index 2f5402de97..075d4e542e 100644 --- a/SRC/claqr3.f +++ b/SRC/claqr3.f @@ -301,7 +301,7 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLAQR4, - $ CLARF, CLARFG, CLASET, CTREXC, CUNMHR, SLABAD + $ CLARF, CLARFG, CLASET, CTREXC, CUNMHR * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL @@ -365,7 +365,6 @@ SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N ) / ULP ) * diff --git a/SRC/claqr5.f b/SRC/claqr5.f index 4e6f43a73d..7168d567c2 100644 --- a/SRC/claqr5.f +++ b/SRC/claqr5.f @@ -300,8 +300,7 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, COMPLEX VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL CGEMM, CLACPY, CLAQR1, CLARFG, CLASET, CTRMM, - $ SLABAD + EXTERNAL CGEMM, CLACPY, CLAQR1, CLARFG, CLASET, CTRMM * .. * .. Statement Functions .. REAL CABS1 @@ -331,7 +330,6 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N ) / ULP ) * diff --git a/SRC/claqz0.f b/SRC/claqz0.f index 6de40e06ca..a09cdead1d 100644 --- a/SRC/claqz0.f +++ b/SRC/claqz0.f @@ -310,7 +310,7 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, CHARACTER :: JBCMPZ*3 * External Functions - EXTERNAL :: XERBLA, CHGEQZ, CLAQZ2, CLAQZ3, CLASET, SLABAD, + EXTERNAL :: XERBLA, CHGEQZ, CLAQZ2, CLAQZ3, CLASET, $ CLARTG, CROT REAL, EXTERNAL :: SLAMCH, CLANHS LOGICAL, EXTERNAL :: LSAME @@ -462,7 +462,6 @@ RECURSIVE SUBROUTINE CLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N )/ULP ) diff --git a/SRC/claqz2.f b/SRC/claqz2.f index 895e0095bf..1f3973048e 100644 --- a/SRC/claqz2.f +++ b/SRC/claqz2.f @@ -257,7 +257,7 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, COMPLEX :: S, S1, TEMP * External Functions - EXTERNAL :: XERBLA, CLAQZ0, CLAQZ1, SLABAD, CLACPY, CLASET, CGEMM, + EXTERNAL :: XERBLA, CLAQZ0, CLAQZ1, CLACPY, CLASET, CGEMM, $ CTGEXC, CLARTG, CROT REAL, EXTERNAL :: SLAMCH @@ -296,7 +296,6 @@ RECURSIVE SUBROUTINE CLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N )/ULP ) diff --git a/SRC/claqz3.f b/SRC/claqz3.f index fecba656d2..a55ebc20b8 100644 --- a/SRC/claqz3.f +++ b/SRC/claqz3.f @@ -230,8 +230,7 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, COMPLEX :: TEMP, TEMP2, TEMP3, S * External Functions - EXTERNAL :: XERBLA, SLABAD, CLASET, CLARTG, CROT, CLAQZ1, CGEMM, - $ CLACPY + EXTERNAL :: XERBLA, CLASET, CLARTG, CROT, CLAQZ1, CGEMM, CLACPY REAL, EXTERNAL :: SLAMCH INFO = 0 @@ -258,7 +257,6 @@ SUBROUTINE CLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) IF ( ILO .GE. IHI ) THEN RETURN diff --git a/SRC/clatps.f b/SRC/clatps.f index a5578b5d49..50af9f585c 100644 --- a/SRC/clatps.f +++ b/SRC/clatps.f @@ -266,7 +266,7 @@ SUBROUTINE CLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, $ CDOTU, CLADIV * .. * .. External Subroutines .. - EXTERNAL CAXPY, CSSCAL, CTPSV, SLABAD, SSCAL, XERBLA + EXTERNAL CAXPY, CSSCAL, CTPSV, SSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL @@ -315,7 +315,6 @@ SUBROUTINE CLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, * SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM / SLAMCH( 'Precision' ) BIGNUM = ONE / SMLNUM SCALE = ONE diff --git a/SRC/csrscl.f b/SRC/csrscl.f index 5f27f63872..157447777f 100644 --- a/SRC/csrscl.f +++ b/SRC/csrscl.f @@ -109,7 +109,7 @@ SUBROUTINE CSRSCL( N, SA, SX, INCX ) EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL CSSCAL, SLABAD + EXTERNAL CSSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS @@ -125,7 +125,6 @@ SUBROUTINE CSRSCL( N, SA, SX, INCX ) * SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Initialize the denominator to SA and the numerator to 1. * diff --git a/SRC/ctgevc.f b/SRC/ctgevc.f index 4e5289cb20..d3869e68e9 100644 --- a/SRC/ctgevc.f +++ b/SRC/ctgevc.f @@ -259,7 +259,7 @@ SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, EXTERNAL LSAME, SLAMCH, CLADIV * .. * .. External Subroutines .. - EXTERNAL CGEMV, SLABAD, XERBLA + EXTERNAL CGEMV, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL @@ -367,7 +367,6 @@ SUBROUTINE CTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * SAFMIN = SLAMCH( 'Safe minimum' ) BIG = ONE / SAFMIN - CALL SLABAD( SAFMIN, BIG ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMALL = SAFMIN*N / ULP BIG = ONE / SMALL diff --git a/SRC/ctgsna.f b/SRC/ctgsna.f index 2295dc5ccc..c1ca0aee54 100644 --- a/SRC/ctgsna.f +++ b/SRC/ctgsna.f @@ -348,7 +348,7 @@ SUBROUTINE CTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, EXTERNAL LSAME, SCNRM2, SLAMCH, SLAPY2, CDOTC * .. * .. External Subroutines .. - EXTERNAL CGEMV, CLACPY, CTGEXC, CTGSYL, SLABAD, XERBLA + EXTERNAL CGEMV, CLACPY, CTGEXC, CTGSYL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, MAX @@ -428,7 +428,6 @@ SUBROUTINE CTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) KS = 0 DO 20 K = 1, N * diff --git a/SRC/ctrevc.f b/SRC/ctrevc.f index 42880ab427..1cb3f67e73 100644 --- a/SRC/ctrevc.f +++ b/SRC/ctrevc.f @@ -253,7 +253,7 @@ SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, ICAMAX, SCASUM, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CCOPY, CGEMV, CLATRS, CSSCAL, SLABAD, XERBLA + EXTERNAL CCOPY, CGEMV, CLATRS, CSSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, REAL @@ -319,7 +319,6 @@ SUBROUTINE CTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) * diff --git a/SRC/ctrevc3.f b/SRC/ctrevc3.f index 0f58696b2b..43366d35b0 100644 --- a/SRC/ctrevc3.f +++ b/SRC/ctrevc3.f @@ -283,7 +283,7 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * .. * .. External Subroutines .. EXTERNAL XERBLA, CCOPY, CLASET, CSSCAL, CGEMM, CGEMV, - $ CLATRS, CLACPY, SLABAD + $ CLATRS, CLACPY * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, CMPLX, CONJG, AIMAG, MAX @@ -371,7 +371,6 @@ SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) * diff --git a/SRC/ctrsna.f b/SRC/ctrsna.f index b8074907c0..4d64aa27c8 100644 --- a/SRC/ctrsna.f +++ b/SRC/ctrsna.f @@ -288,8 +288,7 @@ SUBROUTINE CTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, ICAMAX, SCNRM2, SLAMCH, CDOTC * .. * .. External Subroutines .. - EXTERNAL CLACN2, CLACPY, CLATRS, CSRSCL, CTREXC, SLABAD, - $ XERBLA + EXTERNAL CLACN2, CLACPY, CLATRS, CSRSCL, CTREXC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, MAX, REAL @@ -368,7 +367,6 @@ SUBROUTINE CTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * KS = 1 DO 50 K = 1, N diff --git a/SRC/ctrsyl.f b/SRC/ctrsyl.f index 7a2243ee9b..646bfe1eea 100644 --- a/SRC/ctrsyl.f +++ b/SRC/ctrsyl.f @@ -191,7 +191,7 @@ SUBROUTINE CTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EXTERNAL LSAME, CLANGE, SLAMCH, CDOTC, CDOTU, CLADIV * .. * .. External Subroutines .. - EXTERNAL CSSCAL, SLABAD, XERBLA + EXTERNAL CSSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL @@ -237,7 +237,6 @@ SUBROUTINE CTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM*REAL( M*N ) / EPS BIGNUM = ONE / SMLNUM SMIN = MAX( SMLNUM, EPS*CLANGE( 'M', M, M, A, LDA, DUM ), diff --git a/SRC/dgees.f b/SRC/dgees.f index 24739b1cf7..e0f9d3c76b 100644 --- a/SRC/dgees.f +++ b/SRC/dgees.f @@ -251,7 +251,7 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, * .. * .. External Subroutines .. EXTERNAL DCOPY, DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, - $ DLABAD, DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA + $ DLASCL, DORGHR, DSWAP, DTRSEN, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -338,7 +338,6 @@ SUBROUTINE DGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dgeesx.f b/SRC/dgeesx.f index f3677fcb30..da8136d99b 100644 --- a/SRC/dgeesx.f +++ b/SRC/dgeesx.f @@ -324,7 +324,7 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, LOGICAL LSAME INTEGER ILAENV DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL LSAME, ILAENV, DLABAD, DLAMCH, DLANGE + EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE * .. * .. Intrinsic Functions .. INTRINSIC MAX, SQRT @@ -426,7 +426,6 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dgeev.f b/SRC/dgeev.f index 4677b9f520..de25557f91 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -223,9 +223,8 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, - $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3, - $ XERBLA + EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG, + $ DLASCL, DORGHR, DROT, DSCAL, DTREVC3, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -336,7 +335,6 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dgeevx.f b/SRC/dgeevx.f index 212bea2bb3..2ec0f09ce1 100644 --- a/SRC/dgeevx.f +++ b/SRC/dgeevx.f @@ -341,9 +341,9 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, - $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3, - $ DTRSNA, XERBLA + EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLACPY, DLARTG, + $ DLASCL, DORGHR, DROT, DSCAL, DTREVC3, DTRSNA, + $ XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -477,7 +477,6 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dgels.f b/SRC/dgels.f index 3d0c6155dd..68a44b6dca 100644 --- a/SRC/dgels.f +++ b/SRC/dgels.f @@ -211,7 +211,7 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, LOGICAL LSAME INTEGER ILAENV DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL LSAME, ILAENV, DLABAD, DLAMCH, DLANGE + EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE * .. * .. External Subroutines .. EXTERNAL DGELQF, DGEQRF, DLASCL, DLASET, DORMLQ, DORMQR, @@ -295,7 +295,6 @@ SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/dgelsd.f b/SRC/dgelsd.f index b3b3d8b2d3..46de3d7fbd 100644 --- a/SRC/dgelsd.f +++ b/SRC/dgelsd.f @@ -234,7 +234,7 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM * .. * .. External Subroutines .. - EXTERNAL DGEBRD, DGELQF, DGEQRF, DLABAD, DLACPY, DLALSD, + EXTERNAL DGEBRD, DGELQF, DGEQRF, DLACPY, DLALSD, $ DLASCL, DLASET, DORMBR, DORMLQ, DORMQR, XERBLA * .. * .. External Functions .. @@ -378,7 +378,6 @@ SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, SFMIN = DLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A if max entry outside range [SMLNUM,BIGNUM]. * diff --git a/SRC/dgelss.f b/SRC/dgelss.f index c4190f2e09..0a0c9ba7b8 100644 --- a/SRC/dgelss.f +++ b/SRC/dgelss.f @@ -203,7 +203,7 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * .. * .. External Subroutines .. EXTERNAL DBDSQR, DCOPY, DGEBRD, DGELQF, DGEMM, DGEMV, - $ DGEQRF, DLABAD, DLACPY, DLASCL, DLASET, DORGBR, + $ DGEQRF, DLACPY, DLASCL, DLASET, DORGBR, $ DORMBR, DORMLQ, DORMQR, DRSCL, XERBLA * .. * .. External Functions .. @@ -385,7 +385,6 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, SFMIN = DLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/dgelst.f b/SRC/dgelst.f index ca0e04a9b8..e40411b24d 100644 --- a/SRC/dgelst.f +++ b/SRC/dgelst.f @@ -226,8 +226,8 @@ SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DGELQT, DGEQRT, DGEMLQT, DGEMQRT, DLABAD, - $ DLASCL, DLASET, DTRTRS, XERBLA + EXTERNAL DGELQT, DGEQRT, DGEMLQT, DGEMQRT, DLASCL, + $ DLASET, DTRTRS, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN @@ -309,7 +309,6 @@ SUBROUTINE DGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/dgelsy.f b/SRC/dgelsy.f index aebab92640..00a4f7be8f 100644 --- a/SRC/dgelsy.f +++ b/SRC/dgelsy.f @@ -236,7 +236,7 @@ SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, EXTERNAL ILAENV, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEQP3, DLABAD, DLAIC1, DLASCL, DLASET, + EXTERNAL DCOPY, DGEQP3, DLAIC1, DLASCL, DLASET, $ DORMQR, DORMRZ, DTRSM, DTZRZF, XERBLA * .. * .. Intrinsic Functions .. @@ -305,7 +305,6 @@ SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max entries outside range [SMLNUM,BIGNUM] * diff --git a/SRC/dgesc2.f b/SRC/dgesc2.f index 813bdf625d..d27a5f4a0d 100644 --- a/SRC/dgesc2.f +++ b/SRC/dgesc2.f @@ -136,7 +136,7 @@ SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) DOUBLE PRECISION BIGNUM, EPS, SMLNUM, TEMP * .. * .. External Subroutines .. - EXTERNAL DLASWP, DSCAL, DLABAD + EXTERNAL DLASWP, DSCAL * .. * .. External Functions .. INTEGER IDAMAX @@ -153,7 +153,6 @@ SUBROUTINE DGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Apply permutations IPIV to RHS * diff --git a/SRC/dgetc2.f b/SRC/dgetc2.f index d2f0ede826..e8ced23e71 100644 --- a/SRC/dgetc2.f +++ b/SRC/dgetc2.f @@ -132,7 +132,7 @@ SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO ) DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX * .. * .. External Subroutines .. - EXTERNAL DGER, DSWAP, DLABAD + EXTERNAL DGER, DSWAP * .. * .. External Functions .. DOUBLE PRECISION DLAMCH @@ -155,7 +155,6 @@ SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Handle the case N=1 by itself * diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f index 25f4c12c29..68409604b8 100644 --- a/SRC/dgetsls.f +++ b/SRC/dgetsls.f @@ -189,7 +189,7 @@ SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * .. External Functions .. LOGICAL LSAME DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL LSAME, DLABAD, DLAMCH, DLANGE + EXTERNAL LSAME, DLAMCH, DLANGE * .. * .. External Subroutines .. EXTERNAL DGEQR, DGEMQR, DLASCL, DLASET, @@ -294,7 +294,6 @@ SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/dgges.f b/SRC/dgges.f index 31db23715d..f99a44e729 100644 --- a/SRC/dgges.f +++ b/SRC/dgges.f @@ -321,9 +321,8 @@ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD, - $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, - $ XERBLA + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -431,7 +430,6 @@ SUBROUTINE DGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, EPS = DLAMCH( 'P' ) SAFMIN = DLAMCH( 'S' ) SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) SMLNUM = SQRT( SAFMIN ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dgges3.f b/SRC/dgges3.f index 7b00d294af..15305a8af5 100644 --- a/SRC/dgges3.f +++ b/SRC/dgges3.f @@ -318,9 +318,8 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD, - $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, - $ XERBLA + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY, + $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -430,7 +429,6 @@ SUBROUTINE DGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, EPS = DLAMCH( 'P' ) SAFMIN = DLAMCH( 'S' ) SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) SMLNUM = SQRT( SAFMIN ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dggesx.f b/SRC/dggesx.f index 932c74227a..133ed46986 100644 --- a/SRC/dggesx.f +++ b/SRC/dggesx.f @@ -405,9 +405,8 @@ SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD, - $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, - $ XERBLA + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + $ DLASCL, DLASET, DORGQR, DORMQR, DTGSEN, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -544,7 +543,6 @@ SUBROUTINE DGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, EPS = DLAMCH( 'P' ) SAFMIN = DLAMCH( 'S' ) SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) SMLNUM = SQRT( SAFMIN ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dggev.f b/SRC/dggev.f index a02203e059..3e08de19cb 100644 --- a/SRC/dggev.f +++ b/SRC/dggev.f @@ -257,9 +257,8 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD, - $ DLACPY,DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, - $ XERBLA + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -358,7 +357,6 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dggev3.f b/SRC/dggev3.f index 4bbe8a40f5..c9d7e8e4fd 100644 --- a/SRC/dggev3.f +++ b/SRC/dggev3.f @@ -256,9 +256,8 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD, - $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, - $ XERBLA + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLACPY, + $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -367,7 +366,6 @@ SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dggevx.f b/SRC/dggevx.f index b69f3f9bf6..0dfac7a726 100644 --- a/SRC/dggevx.f +++ b/SRC/dggevx.f @@ -427,9 +427,9 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD, - $ DLACPY, DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, - $ DTGSNA, XERBLA + EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLACPY, + $ DLASCL, DLASET, DORGQR, DORMQR, DTGEVC, DTGSNA, + $ XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -559,7 +559,6 @@ SUBROUTINE DGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/dlabad.f b/SRC/dlabad.f index 95b35e53b8..f236a763bf 100644 --- a/SRC/dlabad.f +++ b/SRC/dlabad.f @@ -30,14 +30,10 @@ *> *> \verbatim *> -*> DLABAD takes as input the values computed by DLAMCH for underflow and -*> overflow, and returns the square root of each of these values if the -*> log of LARGE is sufficiently large. This subroutine is intended to -*> identify machines with a large exponent range, such as the Crays, and -*> redefine the underflow and overflow limits to be the square roots of -*> the values computed by DLAMCH. This subroutine is needed because -*> DLAMCH does not compensate for poor arithmetic in the upper half of -*> the exponent range, as is found on a Cray. +*> DLABAD is a no-op and kept for compatibility reasons. It used +*> to correct the overflow/underflow behavior of machines that +*> are not IEEE-754 compliant. +*> *> \endverbatim * * Arguments: @@ -47,16 +43,14 @@ *> \verbatim *> SMALL is DOUBLE PRECISION *> On entry, the underflow threshold as computed by DLAMCH. -*> On exit, if LOG10(LARGE) is sufficiently large, the square -*> root of SMALL, otherwise unchanged. +*> On exit, the unchanged value SMALL. *> \endverbatim *> *> \param[in,out] LARGE *> \verbatim *> LARGE is DOUBLE PRECISION *> On entry, the overflow threshold as computed by DLAMCH. -*> On exit, if LOG10(LARGE) is sufficiently large, the square -*> root of LARGE, otherwise unchanged. +*> On exit, the unchanged value LARGE. *> \endverbatim * * Authors: @@ -90,10 +84,10 @@ SUBROUTINE DLABAD( SMALL, LARGE ) * If it looks like we're on a Cray, take the square root of * SMALL and LARGE to avoid overflow and underflow problems. * - IF( LOG10( LARGE ).GT.2000.D0 ) THEN - SMALL = SQRT( SMALL ) - LARGE = SQRT( LARGE ) - END IF +* IF( LOG10( LARGE ).GT.2000.D0 ) THEN +* SMALL = SQRT( SMALL ) +* LARGE = SQRT( LARGE ) +* END IF * RETURN * diff --git a/SRC/dlahqr.f b/SRC/dlahqr.f index 449134b865..e3eb293cc3 100644 --- a/SRC/dlahqr.f +++ b/SRC/dlahqr.f @@ -244,7 +244,7 @@ SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DLANV2, DLARFG, DROT + EXTERNAL DCOPY, DLANV2, DLARFG, DROT * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SQRT @@ -278,7 +278,6 @@ SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( NH ) / ULP ) * diff --git a/SRC/dlaqr2.f b/SRC/dlaqr2.f index 515c836582..ee50484231 100644 --- a/SRC/dlaqr2.f +++ b/SRC/dlaqr2.f @@ -309,7 +309,7 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR, + EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, DLAHQR, $ DLANV2, DLARF, DLARFG, DLASET, DORMHR, DTREXC * .. * .. Intrinsic Functions .. @@ -362,7 +362,6 @@ SUBROUTINE DLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N ) / ULP ) * diff --git a/SRC/dlaqr3.f b/SRC/dlaqr3.f index 36e08f02e8..ace0a19422 100644 --- a/SRC/dlaqr3.f +++ b/SRC/dlaqr3.f @@ -307,9 +307,8 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH, ILAENV * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEHRD, DGEMM, DLABAD, DLACPY, DLAHQR, - $ DLANV2, DLAQR4, DLARF, DLARFG, DLASET, DORMHR, - $ DTREXC + EXTERNAL DCOPY, DGEHRD, DGEMM, DLACPY, DLAHQR, DLANV2, + $ DLAQR4, DLARF, DLARFG, DLASET, DORMHR, DTREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN, SQRT @@ -367,7 +366,6 @@ SUBROUTINE DLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N ) / ULP ) * diff --git a/SRC/dlaqr5.f b/SRC/dlaqr5.f index cc94b12223..446186553d 100644 --- a/SRC/dlaqr5.f +++ b/SRC/dlaqr5.f @@ -306,8 +306,7 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, DOUBLE PRECISION VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLABAD, DLACPY, DLAQR1, DLARFG, DLASET, - $ DTRMM + EXTERNAL DGEMM, DLACPY, DLAQR1, DLARFG, DLASET, DTRMM * .. * .. Executable Statements .. * @@ -353,7 +352,6 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N ) / ULP ) * diff --git a/SRC/dlaqz0.f b/SRC/dlaqz0.f index c4cb95fd32..0a3f43e2a3 100644 --- a/SRC/dlaqz0.f +++ b/SRC/dlaqz0.f @@ -332,7 +332,7 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, CHARACTER :: JBCMPZ*3 * External Functions - EXTERNAL :: XERBLA, DHGEQZ, DLASET, DLAQZ3, DLAQZ4, DLABAD, + EXTERNAL :: XERBLA, DHGEQZ, DLASET, DLAQZ3, DLAQZ4, $ DLARTG, DROT DOUBLE PRECISION, EXTERNAL :: DLAMCH, DLANHS LOGICAL, EXTERNAL :: LSAME @@ -482,7 +482,6 @@ RECURSIVE SUBROUTINE DLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N )/ULP ) diff --git a/SRC/dlaqz3.f b/SRC/dlaqz3.f index e85bf0bb77..8f7a0906b8 100644 --- a/SRC/dlaqz3.f +++ b/SRC/dlaqz3.f @@ -260,7 +260,7 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, DOUBLE PRECISION :: S, SMLNUM, ULP, SAFMIN, SAFMAX, C1, S1, TEMP * External Functions - EXTERNAL :: XERBLA, DTGEXC, DLABAD, DLAQZ0, DLACPY, DLASET, + EXTERNAL :: XERBLA, DTGEXC, DLAQZ0, DLACPY, DLASET, $ DLAQZ2, DROT, DLARTG, DLAG2, DGEMM DOUBLE PRECISION, EXTERNAL :: DLAMCH @@ -302,7 +302,6 @@ RECURSIVE SUBROUTINE DLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N )/ULP ) diff --git a/SRC/drscl.f b/SRC/drscl.f index fcd8569650..cfd1363d6c 100644 --- a/SRC/drscl.f +++ b/SRC/drscl.f @@ -109,7 +109,7 @@ SUBROUTINE DRSCL( N, SA, SX, INCX ) EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DSCAL, DLABAD + EXTERNAL DSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS @@ -125,7 +125,6 @@ SUBROUTINE DRSCL( N, SA, SX, INCX ) * SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Initialize the denominator to SA and the numerator to 1. * diff --git a/SRC/dtgevc.f b/SRC/dtgevc.f index e7084664cb..282064890f 100644 --- a/SRC/dtgevc.f +++ b/SRC/dtgevc.f @@ -337,7 +337,7 @@ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, EXTERNAL LSAME, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DGEMV, DLABAD, DLACPY, DLAG2, DLALN2, XERBLA + EXTERNAL DGEMV, DLACPY, DLAG2, DLALN2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -463,7 +463,6 @@ SUBROUTINE DTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * SAFMIN = DLAMCH( 'Safe minimum' ) BIG = ONE / SAFMIN - CALL DLABAD( SAFMIN, BIG ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMALL = SAFMIN*N / ULP BIG = ONE / SMALL diff --git a/SRC/dtrevc.f b/SRC/dtrevc.f index 149b43c789..e0e7a2676d 100644 --- a/SRC/dtrevc.f +++ b/SRC/dtrevc.f @@ -254,8 +254,7 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, IDAMAX, DDOT, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, - $ XERBLA + EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -341,7 +340,6 @@ SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) BIGNUM = ( ONE-ULP ) / SMLNUM diff --git a/SRC/dtrevc3.f b/SRC/dtrevc3.f index a4651e788f..245930412f 100644 --- a/SRC/dtrevc3.f +++ b/SRC/dtrevc3.f @@ -275,7 +275,7 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * .. * .. External Subroutines .. EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA, - $ DGEMM, DLASET, DLABAD, DLACPY + $ DGEMM, DLASET, DLACPY * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -381,7 +381,6 @@ SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) BIGNUM = ( ONE-ULP ) / SMLNUM diff --git a/SRC/dtrsna.f b/SRC/dtrsna.f index ffcfe0545f..fbe72f7cc8 100644 --- a/SRC/dtrsna.f +++ b/SRC/dtrsna.f @@ -300,7 +300,7 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, DDOT, DLAMCH, DLAPY2, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLACN2, DLACPY, DLAQTR, DTREXC, XERBLA + EXTERNAL DLACN2, DLACPY, DLAQTR, DTREXC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -392,7 +392,6 @@ SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * KS = 0 PAIR = .FALSE. diff --git a/SRC/dtrsyl.f b/SRC/dtrsyl.f index ea1fd4f19a..1d418e0ace 100644 --- a/SRC/dtrsyl.f +++ b/SRC/dtrsyl.f @@ -196,7 +196,7 @@ SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EXTERNAL LSAME, DDOT, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLALN2, DLASY2, DSCAL, XERBLA + EXTERNAL DLALN2, DLASY2, DSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN @@ -244,7 +244,6 @@ SUBROUTINE DTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM*DBLE( M*N ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sgees.f b/SRC/sgees.f index 6febd549cf..1a418ff3cc 100644 --- a/SRC/sgees.f +++ b/SRC/sgees.f @@ -250,8 +250,8 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, - $ SLACPY, SLASCL, SORGHR, SSWAP, STRSEN, XERBLA + EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, + $ SLASCL, SORGHR, SSWAP, STRSEN, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -338,7 +338,6 @@ SUBROUTINE SGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sgeesx.f b/SRC/sgeesx.f index 6810fe7c80..d1fc4b59ee 100644 --- a/SRC/sgeesx.f +++ b/SRC/sgeesx.f @@ -317,7 +317,7 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, + EXTERNAL SCOPY, SGEBAK, SGEBAL, SGEHRD, SHSEQR, $ SLACPY, SLASCL, SORGHR, SSWAP, STRSEN, XERBLA * .. * .. External Functions .. @@ -426,7 +426,6 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sgeev.f b/SRC/sgeev.f index ed17247219..0298b5537f 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -223,9 +223,8 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, - $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC3, - $ XERBLA + EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, SLARTG, + $ SLASCL, SORGHR, SROT, SSCAL, STREVC3, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -336,7 +335,6 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sgeevx.f b/SRC/sgeevx.f index ed1ea1cb98..58b6eba539 100644 --- a/SRC/sgeevx.f +++ b/SRC/sgeevx.f @@ -341,7 +341,7 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, + EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLACPY, $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC3, $ STRSNA, XERBLA * .. @@ -477,7 +477,6 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sgels.f b/SRC/sgels.f index ea02c3318b..ba3fd4e2dd 100644 --- a/SRC/sgels.f +++ b/SRC/sgels.f @@ -214,7 +214,7 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SGELQF, SGEQRF, SLABAD, SLASCL, SLASET, SORMLQ, + EXTERNAL SGELQF, SGEQRF, SLASCL, SLASET, SORMLQ, $ SORMQR, STRTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -295,7 +295,6 @@ SUBROUTINE SGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/sgelsd.f b/SRC/sgelsd.f index f5f17d34c5..a680472e1a 100644 --- a/SRC/sgelsd.f +++ b/SRC/sgelsd.f @@ -235,8 +235,8 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, REAL ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM * .. * .. External Subroutines .. - EXTERNAL SGEBRD, SGELQF, SGEQRF, SLABAD, SLACPY, SLALSD, - $ SLASCL, SLASET, SORMBR, SORMLQ, SORMQR, XERBLA + EXTERNAL SGEBRD, SGELQF, SGEQRF, SLACPY, SLALSD, SLASCL, + $ SLASET, SORMBR, SORMLQ, SORMQR, XERBLA * .. * .. External Functions .. INTEGER ILAENV @@ -382,7 +382,6 @@ SUBROUTINE SGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, SFMIN = SLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A if max entry outside range [SMLNUM,BIGNUM]. * diff --git a/SRC/sgelss.f b/SRC/sgelss.f index 9aed4329f7..5e67afd79e 100644 --- a/SRC/sgelss.f +++ b/SRC/sgelss.f @@ -202,7 +202,7 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, * .. * .. External Subroutines .. EXTERNAL SBDSQR, SCOPY, SGEBRD, SGELQF, SGEMM, SGEMV, - $ SGEQRF, SLABAD, SLACPY, SLASCL, SLASET, SORGBR, + $ SGEQRF, SLACPY, SLASCL, SLASET, SORGBR, $ SORMBR, SORMLQ, SORMQR, SRSCL, XERBLA * .. * .. External Functions .. @@ -381,7 +381,6 @@ SUBROUTINE SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, SFMIN = SLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/sgelst.f b/SRC/sgelst.f index 5377bc720a..2999ef7da0 100644 --- a/SRC/sgelst.f +++ b/SRC/sgelst.f @@ -226,7 +226,7 @@ SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SGELQT, SGEQRT, SGEMLQT, SGEMQRT, SLABAD, + EXTERNAL SGELQT, SGEQRT, SGEMLQT, SGEMQRT, $ SLASCL, SLASET, STRTRS, XERBLA * .. * .. Intrinsic Functions .. @@ -309,7 +309,6 @@ SUBROUTINE SGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/sgelsy.f b/SRC/sgelsy.f index 9c60f78a7a..bcb8d5025d 100644 --- a/SRC/sgelsy.f +++ b/SRC/sgelsy.f @@ -236,7 +236,7 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, EXTERNAL ILAENV, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEQP3, SLABAD, SLAIC1, SLASCL, SLASET, + EXTERNAL SCOPY, SGEQP3, SLAIC1, SLASCL, SLASET, $ SORMQR, SORMRZ, STRSM, STZRZF, XERBLA * .. * .. Intrinsic Functions .. @@ -305,7 +305,6 @@ SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max entries outside range [SMLNUM,BIGNUM] * diff --git a/SRC/sgesc2.f b/SRC/sgesc2.f index 2de2ed7ccb..549327bc84 100644 --- a/SRC/sgesc2.f +++ b/SRC/sgesc2.f @@ -136,7 +136,7 @@ SUBROUTINE SGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) REAL BIGNUM, EPS, SMLNUM, TEMP * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLASWP, SSCAL + EXTERNAL SLASWP, SSCAL * .. * .. External Functions .. INTEGER ISAMAX @@ -153,7 +153,6 @@ SUBROUTINE SGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Apply permutations IPIV to RHS * diff --git a/SRC/sgetc2.f b/SRC/sgetc2.f index a871a03ff3..18c8f8b7ac 100644 --- a/SRC/sgetc2.f +++ b/SRC/sgetc2.f @@ -132,7 +132,7 @@ SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO ) REAL BIGNUM, EPS, SMIN, SMLNUM, XMAX * .. * .. External Subroutines .. - EXTERNAL SGER, SLABAD, SSWAP + EXTERNAL SGER, SSWAP * .. * .. External Functions .. REAL SLAMCH @@ -155,7 +155,6 @@ SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Handle the case N=1 by itself * diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f index e6ce705fa4..0a4a835b4f 100644 --- a/SRC/sgetsls.f +++ b/SRC/sgetsls.f @@ -189,7 +189,7 @@ SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * .. External Functions .. LOGICAL LSAME REAL SLAMCH, SLANGE - EXTERNAL LSAME, SLABAD, SLAMCH, SLANGE + EXTERNAL LSAME, SLAMCH, SLANGE * .. * .. External Subroutines .. EXTERNAL SGEQR, SGEMQR, SLASCL, SLASET, @@ -294,7 +294,6 @@ SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/sgges.f b/SRC/sgges.f index 3834aea000..5aeaf2a14a 100644 --- a/SRC/sgges.f +++ b/SRC/sgges.f @@ -321,9 +321,8 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD, - $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGSEN, - $ XERBLA + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + $ SLASCL, SLASET, SORGQR, SORMQR, STGSEN * .. * .. External Functions .. LOGICAL LSAME @@ -431,7 +430,6 @@ SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, EPS = SLAMCH( 'P' ) SAFMIN = SLAMCH( 'S' ) SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) SMLNUM = SQRT( SAFMIN ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sgges3.f b/SRC/sgges3.f index b27704ff50..9beafbbe7e 100644 --- a/SRC/sgges3.f +++ b/SRC/sgges3.f @@ -318,9 +318,8 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLABAD, - $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGSEN, - $ XERBLA + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLACPY, + $ SLASCL, SLASET, SORGQR, SORMQR, STGSEN, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -430,7 +429,6 @@ SUBROUTINE SGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, EPS = SLAMCH( 'P' ) SAFMIN = SLAMCH( 'S' ) SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) SMLNUM = SQRT( SAFMIN ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sggesx.f b/SRC/sggesx.f index a6c0443bac..cdd22fd196 100644 --- a/SRC/sggesx.f +++ b/SRC/sggesx.f @@ -405,9 +405,8 @@ SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, REAL DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD, - $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGSEN, - $ XERBLA + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + $ SLASCL, SLASET, SORGQR, SORMQR, STGSEN, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -544,7 +543,6 @@ SUBROUTINE SGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, EPS = SLAMCH( 'P' ) SAFMIN = SLAMCH( 'S' ) SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) SMLNUM = SQRT( SAFMIN ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sggev.f b/SRC/sggev.f index 69744b72b4..acbd0baeeb 100644 --- a/SRC/sggev.f +++ b/SRC/sggev.f @@ -257,9 +257,8 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD, - $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGEVC, - $ XERBLA + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC, XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -358,7 +357,6 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sggev3.f b/SRC/sggev3.f index 945c3a017d..d79bd45959 100644 --- a/SRC/sggev3.f +++ b/SRC/sggev3.f @@ -256,9 +256,8 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLABAD, - $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGEVC, - $ XERBLA + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLACPY, + $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC * .. * .. External Functions .. LOGICAL LSAME @@ -362,7 +361,6 @@ SUBROUTINE SGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/sggevx.f b/SRC/sggevx.f index bb05f499af..f656d2eebf 100644 --- a/SRC/sggevx.f +++ b/SRC/sggevx.f @@ -427,9 +427,9 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD, - $ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGEVC, - $ STGSNA, XERBLA + EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLACPY, + $ SLASCL, SLASET, SORGQR, SORMQR, STGEVC, STGSNA, + $ XERBLA * .. * .. External Functions .. LOGICAL LSAME @@ -557,7 +557,6 @@ SUBROUTINE SGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/slabad.f b/SRC/slabad.f index cb223594f4..11604e784e 100644 --- a/SRC/slabad.f +++ b/SRC/slabad.f @@ -30,14 +30,9 @@ *> *> \verbatim *> -*> SLABAD takes as input the values computed by SLAMCH for underflow and -*> overflow, and returns the square root of each of these values if the -*> log of LARGE is sufficiently large. This subroutine is intended to -*> identify machines with a large exponent range, such as the Crays, and -*> redefine the underflow and overflow limits to be the square roots of -*> the values computed by SLAMCH. This subroutine is needed because -*> SLAMCH does not compensate for poor arithmetic in the upper half of -*> the exponent range, as is found on a Cray. +*> SLABAD is a no-op and kept for compatibility reasons. It used +*> to correct the overflow/underflow behavior of machines that +*> are not IEEE-754 compliant. *> \endverbatim * * Arguments: @@ -47,16 +42,14 @@ *> \verbatim *> SMALL is REAL *> On entry, the underflow threshold as computed by SLAMCH. -*> On exit, if LOG10(LARGE) is sufficiently large, the square -*> root of SMALL, otherwise unchanged. +*> On exit, the unchanged value SMALL. *> \endverbatim *> *> \param[in,out] LARGE *> \verbatim *> LARGE is REAL *> On entry, the overflow threshold as computed by SLAMCH. -*> On exit, if LOG10(LARGE) is sufficiently large, the square -*> root of LARGE, otherwise unchanged. +*> On exit, the unchanged value LARGE. *> \endverbatim * * Authors: @@ -90,10 +83,10 @@ SUBROUTINE SLABAD( SMALL, LARGE ) * If it looks like we're on a Cray, take the square root of * SMALL and LARGE to avoid overflow and underflow problems. * - IF( LOG10( LARGE ).GT.2000. ) THEN - SMALL = SQRT( SMALL ) - LARGE = SQRT( LARGE ) - END IF +* IF( LOG10( LARGE ).GT.2000. ) THEN +* SMALL = SQRT( SMALL ) +* LARGE = SQRT( LARGE ) +* END IF * RETURN * diff --git a/SRC/slahqr.f b/SRC/slahqr.f index 4e00f315a6..f137f8e0ec 100644 --- a/SRC/slahqr.f +++ b/SRC/slahqr.f @@ -244,7 +244,7 @@ SUBROUTINE SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLABAD, SLANV2, SLARFG, SROT + EXTERNAL SCOPY, SLANV2, SLARFG, SROT * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SQRT @@ -278,7 +278,6 @@ SUBROUTINE SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( NH ) / ULP ) * diff --git a/SRC/slaqr2.f b/SRC/slaqr2.f index 62c4ef5ebc..6e0da98020 100644 --- a/SRC/slaqr2.f +++ b/SRC/slaqr2.f @@ -309,7 +309,7 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEHRD, SGEMM, SLABAD, SLACPY, SLAHQR, + EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, SLAHQR, $ SLANV2, SLARF, SLARFG, SLASET, SORMHR, STREXC * .. * .. Intrinsic Functions .. @@ -362,7 +362,6 @@ SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N ) / ULP ) * diff --git a/SRC/slaqr3.f b/SRC/slaqr3.f index 519ccd6ede..1f80a1685e 100644 --- a/SRC/slaqr3.f +++ b/SRC/slaqr3.f @@ -307,9 +307,8 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL SLAMCH, ILAENV * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEHRD, SGEMM, SLABAD, SLACPY, SLAHQR, - $ SLANV2, SLAQR4, SLARF, SLARFG, SLASET, SORMHR, - $ STREXC + EXTERNAL SCOPY, SGEHRD, SGEMM, SLACPY, SLAHQR, SLANV2, + $ SLAQR4, SLARF, SLARFG, SLASET, SORMHR, STREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, MAX, MIN, REAL, SQRT @@ -367,7 +366,6 @@ SUBROUTINE SLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N ) / ULP ) * diff --git a/SRC/slaqr5.f b/SRC/slaqr5.f index b10e597542..75a8473f6c 100644 --- a/SRC/slaqr5.f +++ b/SRC/slaqr5.f @@ -306,8 +306,7 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, REAL VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLABAD, SLACPY, SLAQR1, SLARFG, SLASET, - $ STRMM + EXTERNAL SGEMM, SLACPY, SLAQR1, SLARFG, SLASET, STRMM * .. * .. Executable Statements .. * @@ -353,7 +352,6 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, * SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N ) / ULP ) * diff --git a/SRC/slaqz0.f b/SRC/slaqz0.f index 2e06f9d42c..3dc3b7a09c 100644 --- a/SRC/slaqz0.f +++ b/SRC/slaqz0.f @@ -329,7 +329,7 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, CHARACTER :: JBCMPZ*3 * External Functions - EXTERNAL :: XERBLA, SHGEQZ, SLAQZ3, SLAQZ4, SLASET, SLABAD, + EXTERNAL :: XERBLA, SHGEQZ, SLAQZ3, SLAQZ4, SLASET, $ SLARTG, SROT REAL, EXTERNAL :: SLAMCH, SLANHS LOGICAL, EXTERNAL :: LSAME @@ -479,7 +479,6 @@ RECURSIVE SUBROUTINE SLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N )/ULP ) diff --git a/SRC/slaqz3.f b/SRC/slaqz3.f index edb8a6012c..7a2672cce5 100644 --- a/SRC/slaqz3.f +++ b/SRC/slaqz3.f @@ -258,7 +258,7 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, REAL :: S, SMLNUM, ULP, SAFMIN, SAFMAX, C1, S1, TEMP * External Functions - EXTERNAL :: XERBLA, STGEXC, SLABAD, SLAQZ0, SLACPY, SLASET, + EXTERNAL :: XERBLA, STGEXC, SLAQZ0, SLACPY, SLASET, $ SLAQZ2, SROT, SLARTG, SLAG2, SGEMM REAL, EXTERNAL :: SLAMCH @@ -300,7 +300,6 @@ RECURSIVE SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Get machine constants SAFMIN = SLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULP = SLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( REAL( N )/ULP ) diff --git a/SRC/srscl.f b/SRC/srscl.f index 7f2b3bc4f4..b4538d21e5 100644 --- a/SRC/srscl.f +++ b/SRC/srscl.f @@ -109,7 +109,7 @@ SUBROUTINE SRSCL( N, SA, SX, INCX ) EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SLABAD, SSCAL + EXTERNAL SSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS @@ -125,7 +125,6 @@ SUBROUTINE SRSCL( N, SA, SX, INCX ) * SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Initialize the denominator to SA and the numerator to 1. * diff --git a/SRC/stgevc.f b/SRC/stgevc.f index 15fc88c4b4..dd7a24ddc3 100644 --- a/SRC/stgevc.f +++ b/SRC/stgevc.f @@ -337,7 +337,7 @@ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, EXTERNAL LSAME, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SGEMV, SLABAD, SLACPY, SLAG2, SLALN2, XERBLA + EXTERNAL SGEMV, SLACPY, SLAG2, SLALN2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN @@ -463,7 +463,6 @@ SUBROUTINE STGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * SAFMIN = SLAMCH( 'Safe minimum' ) BIG = ONE / SAFMIN - CALL SLABAD( SAFMIN, BIG ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMALL = SAFMIN*N / ULP BIG = ONE / SMALL diff --git a/SRC/strevc.f b/SRC/strevc.f index af97de1d15..f1a7064ddc 100644 --- a/SRC/strevc.f +++ b/SRC/strevc.f @@ -254,8 +254,7 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, ISAMAX, SDOT, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SGEMV, SLABAD, SLALN2, SSCAL, - $ XERBLA + EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -341,7 +340,6 @@ SUBROUTINE STREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) BIGNUM = ( ONE-ULP ) / SMLNUM diff --git a/SRC/strevc3.f b/SRC/strevc3.f index 5af57123bf..225a7ce975 100644 --- a/SRC/strevc3.f +++ b/SRC/strevc3.f @@ -275,7 +275,7 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * .. * .. External Subroutines .. EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, XERBLA, - $ SLACPY, SGEMM, SLABAD, SLASET + $ SLACPY, SGEMM, SLASET * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -381,7 +381,6 @@ SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) BIGNUM = ( ONE-ULP ) / SMLNUM diff --git a/SRC/strsna.f b/SRC/strsna.f index 6d98ac27f2..c915ac02c0 100644 --- a/SRC/strsna.f +++ b/SRC/strsna.f @@ -300,7 +300,7 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, SDOT, SLAMCH, SLAPY2, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLACN2, SLACPY, SLAQTR, STREXC, XERBLA + EXTERNAL SLACN2, SLACPY, SLAQTR, STREXC, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -392,7 +392,6 @@ SUBROUTINE STRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * KS = 0 PAIR = .FALSE. diff --git a/SRC/strsyl.f b/SRC/strsyl.f index e1f90d2c99..3df531879a 100644 --- a/SRC/strsyl.f +++ b/SRC/strsyl.f @@ -196,7 +196,7 @@ SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EXTERNAL LSAME, SDOT, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLALN2, SLASY2, SSCAL, XERBLA + EXTERNAL SLALN2, SLASY2, SSCAL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL @@ -244,7 +244,6 @@ SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM*REAL( M*N ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zdrscl.f b/SRC/zdrscl.f index 9e1b2ea872..338badf425 100644 --- a/SRC/zdrscl.f +++ b/SRC/zdrscl.f @@ -109,7 +109,7 @@ SUBROUTINE ZDRSCL( N, SA, SX, INCX ) EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZDSCAL + EXTERNAL ZDSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS @@ -125,7 +125,6 @@ SUBROUTINE ZDRSCL( N, SA, SX, INCX ) * SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Initialize the denominator to SA and the numerator to 1. * diff --git a/SRC/zgees.f b/SRC/zgees.f index d673087bfb..e2bd855cf0 100644 --- a/SRC/zgees.f +++ b/SRC/zgees.f @@ -229,7 +229,7 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD, + EXTERNAL XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD, $ ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR * .. * .. External Functions .. @@ -318,7 +318,6 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zgeesx.f b/SRC/zgeesx.f index bdd741b113..12418caa49 100644 --- a/SRC/zgeesx.f +++ b/SRC/zgeesx.f @@ -273,8 +273,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, - $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR + EXTERNAL DLASCL, XERBLA, ZCOPY, ZGEBAK, ZGEBAL, ZGEHRD, + $ ZHSEQR, ZLACPY, ZLASCL, ZTRSEN, ZUNGHR * .. * .. External Functions .. LOGICAL LSAME @@ -376,7 +376,6 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zgeev.f b/SRC/zgeev.f index b968900e2f..565704d5ca 100644 --- a/SRC/zgeev.f +++ b/SRC/zgeev.f @@ -212,8 +212,8 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, - $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR + EXTERNAL XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, ZHSEQR, + $ ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR * .. * .. External Functions .. LOGICAL LSAME @@ -315,7 +315,6 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zgeevx.f b/SRC/zgeevx.f index 170a0fc765..9fbffb0386 100644 --- a/SRC/zgeevx.f +++ b/SRC/zgeevx.f @@ -323,9 +323,9 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, DOUBLE PRECISION DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, - $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, - $ ZTRSNA, ZUNGHR + EXTERNAL DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, + $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZTRSNA, + $ ZUNGHR * .. * .. External Functions .. LOGICAL LSAME @@ -458,7 +458,6 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zgels.f b/SRC/zgels.f index ebdbe0d494..ac943081c8 100644 --- a/SRC/zgels.f +++ b/SRC/zgels.f @@ -215,7 +215,7 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGELQF, ZGEQRF, ZLASCL, ZLASET, + EXTERNAL XERBLA, ZGELQF, ZGEQRF, ZLASCL, ZLASET, $ ZTRTRS, ZUNMLQ, ZUNMQR * .. * .. Intrinsic Functions .. @@ -296,7 +296,6 @@ SUBROUTINE ZGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/zgelsd.f b/SRC/zgelsd.f index 01793e16c2..15ca42300f 100644 --- a/SRC/zgelsd.f +++ b/SRC/zgelsd.f @@ -253,9 +253,9 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, DOUBLE PRECISION ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASCL, DLASET, XERBLA, ZGEBRD, ZGELQF, - $ ZGEQRF, ZLACPY, ZLALSD, ZLASCL, ZLASET, ZUNMBR, - $ ZUNMLQ, ZUNMQR + EXTERNAL DLASCL, DLASET, XERBLA, ZGEBRD, ZGELQF, ZGEQRF, + $ ZLACPY, ZLALSD, ZLASCL, ZLASET, ZUNMBR, ZUNMLQ, + $ ZUNMQR * .. * .. External Functions .. INTEGER ILAENV @@ -401,7 +401,6 @@ SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, SFMIN = DLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A if max entry outside range [SMLNUM,BIGNUM]. * diff --git a/SRC/zgelss.f b/SRC/zgelss.f index be53ba95b1..35b815accf 100644 --- a/SRC/zgelss.f +++ b/SRC/zgelss.f @@ -212,10 +212,9 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, COMPLEX*16 DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY, - $ ZDRSCL, ZGEBRD, ZGELQF, ZGEMM, ZGEMV, ZGEQRF, - $ ZLACPY, ZLASCL, ZLASET, ZUNGBR, ZUNMBR, ZUNMLQ, - $ ZUNMQR + EXTERNAL DLASCL, DLASET, XERBLA, ZBDSQR, ZCOPY, ZDRSCL, + $ ZGEBRD, ZGELQF, ZGEMM, ZGEMV, ZGEQRF, ZLACPY, + $ ZLASCL, ZLASET, ZUNGBR, ZUNMBR, ZUNMLQ * .. * .. External Functions .. INTEGER ILAENV @@ -388,7 +387,6 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, SFMIN = DLAMCH( 'S' ) SMLNUM = SFMIN / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/zgelst.f b/SRC/zgelst.f index 4dabdc91e6..927f515218 100644 --- a/SRC/zgelst.f +++ b/SRC/zgelst.f @@ -228,8 +228,8 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL ZGELQT, ZGEQRT, ZGEMLQT, ZGEMQRT, DLABAD, - $ ZLASCL, ZLASET, ZTRTRS, XERBLA + EXTERNAL ZGELQT, ZGEQRT, ZGEMLQT, ZGEMQRT, ZLASCL, + $ ZLASET, ZTRTRS, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN @@ -311,7 +311,6 @@ SUBROUTINE ZGELST( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/zgelsy.f b/SRC/zgelsy.f index 65fa87ae98..6f729eee28 100644 --- a/SRC/zgelsy.f +++ b/SRC/zgelsy.f @@ -242,7 +242,7 @@ SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, COMPLEX*16 C1, C2, S1, S2 * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZCOPY, ZGEQP3, ZLAIC1, ZLASCL, + EXTERNAL XERBLA, ZCOPY, ZGEQP3, ZLAIC1, ZLASCL, $ ZLASET, ZTRSM, ZTZRZF, ZUNMQR, ZUNMRZ * .. * .. External Functions .. @@ -303,7 +303,6 @@ SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max entries outside range [SMLNUM,BIGNUM] * diff --git a/SRC/zgesc2.f b/SRC/zgesc2.f index 9f40fc7008..b3754d9779 100644 --- a/SRC/zgesc2.f +++ b/SRC/zgesc2.f @@ -138,7 +138,7 @@ SUBROUTINE ZGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) COMPLEX*16 TEMP * .. * .. External Subroutines .. - EXTERNAL ZLASWP, ZSCAL, DLABAD + EXTERNAL ZLASWP, ZSCAL * .. * .. External Functions .. INTEGER IZAMAX @@ -155,7 +155,6 @@ SUBROUTINE ZGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Apply permutations IPIV to RHS * diff --git a/SRC/zgetc2.f b/SRC/zgetc2.f index eb97194f29..e1f3c74e75 100644 --- a/SRC/zgetc2.f +++ b/SRC/zgetc2.f @@ -132,7 +132,7 @@ SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX * .. * .. External Subroutines .. - EXTERNAL ZGERU, ZSWAP, DLABAD + EXTERNAL ZGERU, ZSWAP * .. * .. External Functions .. DOUBLE PRECISION DLAMCH @@ -155,7 +155,6 @@ SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Handle the case N=1 by itself * diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f index 17c6d5146d..0b11bb466e 100644 --- a/SRC/zgetsls.f +++ b/SRC/zgetsls.f @@ -192,7 +192,7 @@ SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * .. External Functions .. LOGICAL LSAME DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, DLABAD, DLAMCH, ZLANGE + EXTERNAL LSAME, DLAMCH, ZLANGE * .. * .. External Subroutines .. EXTERNAL ZGEQR, ZGEMQR, ZLASCL, ZLASET, @@ -297,7 +297,6 @@ SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale A, B if max element outside range [SMLNUM,BIGNUM] * diff --git a/SRC/zgges.f b/SRC/zgges.f index 3847adc04d..a67992353e 100644 --- a/SRC/zgges.f +++ b/SRC/zgges.f @@ -311,9 +311,8 @@ SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, - $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, - $ ZUNMQR + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ, + $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR * .. * .. External Functions .. LOGICAL LSAME @@ -415,7 +414,6 @@ SUBROUTINE ZGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zgges3.f b/SRC/zgges3.f index 8b3e44f885..81112a2143 100644 --- a/SRC/zgges3.f +++ b/SRC/zgges3.f @@ -309,9 +309,8 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, - $ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, - $ ZUNMQR + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0, + $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR * .. * .. External Functions .. LOGICAL LSAME @@ -420,7 +419,6 @@ SUBROUTINE ZGGES3( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zggesx.f b/SRC/zggesx.f index 96e4f2cda9..53de433393 100644 --- a/SRC/zggesx.f +++ b/SRC/zggesx.f @@ -372,9 +372,8 @@ SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, DOUBLE PRECISION DIF( 2 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, - $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, - $ ZUNMQR + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ, + $ ZLACPY, ZLASCL, ZLASET, ZTGSEN, ZUNGQR, ZUNMQR * .. * .. External Functions .. LOGICAL LSAME @@ -510,7 +509,6 @@ SUBROUTINE ZGGESX( JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zggev.f b/SRC/zggev.f index 2e6a4d730f..174fe036a5 100644 --- a/SRC/zggev.f +++ b/SRC/zggev.f @@ -253,9 +253,8 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, - $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, - $ ZUNMQR + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, ZHGEQZ, + $ ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR * .. * .. External Functions .. LOGICAL LSAME @@ -359,7 +358,6 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, EPS = DLAMCH( 'E' )*DLAMCH( 'B' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zggev3.f b/SRC/zggev3.f index 2d6c745824..ce035fcc78 100644 --- a/SRC/zggev3.f +++ b/SRC/zggev3.f @@ -252,9 +252,8 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, - $ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, - $ ZUNMQR + EXTERNAL XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3, ZLAQZ0, + $ ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR, ZUNMQR * .. * .. External Functions .. LOGICAL LSAME @@ -368,7 +367,6 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, EPS = DLAMCH( 'E' )*DLAMCH( 'B' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zggevx.f b/SRC/zggevx.f index c63a390e63..616e3a8300 100644 --- a/SRC/zggevx.f +++ b/SRC/zggevx.f @@ -414,9 +414,9 @@ SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, LOGICAL LDUMMA( 1 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASCL, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, - $ ZGGHRD, ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, - $ ZTGSNA, ZUNGQR, ZUNMQR + EXTERNAL DLASCL, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD, + $ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZTGSNA, + $ ZUNGQR, ZUNMQR * .. * .. External Functions .. LOGICAL LSAME @@ -545,7 +545,6 @@ SUBROUTINE ZGGEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SQRT( SMLNUM ) / EPS BIGNUM = ONE / SMLNUM * diff --git a/SRC/zlahqr.f b/SRC/zlahqr.f index 9413f20cc8..d20021f614 100644 --- a/SRC/zlahqr.f +++ b/SRC/zlahqr.f @@ -236,7 +236,7 @@ SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, EXTERNAL ZLADIV, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZCOPY, ZLARFG, ZSCAL + EXTERNAL ZCOPY, ZLARFG, ZSCAL * .. * .. Statement Functions .. DOUBLE PRECISION CABS1 @@ -298,7 +298,6 @@ SUBROUTINE ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILOZ, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( NH ) / ULP ) * diff --git a/SRC/zlaqr2.f b/SRC/zlaqr2.f index f78ea206dd..8294105ca4 100644 --- a/SRC/zlaqr2.f +++ b/SRC/zlaqr2.f @@ -302,7 +302,7 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, + EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, $ ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR * .. * .. Intrinsic Functions .. @@ -361,7 +361,6 @@ SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N ) / ULP ) * diff --git a/SRC/zlaqr3.f b/SRC/zlaqr3.f index c8e5fe9996..cd7eca70ae 100644 --- a/SRC/zlaqr3.f +++ b/SRC/zlaqr3.f @@ -301,8 +301,8 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, EXTERNAL DLAMCH, ILAENV * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, - $ ZLAQR4, ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR + EXTERNAL ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, ZLAQR4, + $ ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN @@ -366,7 +366,6 @@ SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N ) / ULP ) * diff --git a/SRC/zlaqr5.f b/SRC/zlaqr5.f index d8c521349e..153a8a2c6d 100644 --- a/SRC/zlaqr5.f +++ b/SRC/zlaqr5.f @@ -300,8 +300,7 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, COMPLEX*16 VT( 3 ) * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET, - $ ZTRMM + EXTERNAL ZGEMM, ZLACPY, ZLAQR1, ZLARFG, ZLASET, ZTRMM * .. * .. Statement Functions .. DOUBLE PRECISION CABS1 @@ -331,7 +330,6 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S, * SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = RONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N ) / ULP ) * diff --git a/SRC/zlaqz0.f b/SRC/zlaqz0.f index 3e20200ed4..2c2c4124b9 100644 --- a/SRC/zlaqz0.f +++ b/SRC/zlaqz0.f @@ -312,7 +312,7 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, CHARACTER :: JBCMPZ*3 * External Functions - EXTERNAL :: XERBLA, ZHGEQZ, ZLAQZ2, ZLAQZ3, ZLASET, DLABAD, + EXTERNAL :: XERBLA, ZHGEQZ, ZLAQZ2, ZLAQZ3, ZLASET, $ ZLARTG, ZROT DOUBLE PRECISION, EXTERNAL :: DLAMCH, ZLANHS LOGICAL, EXTERNAL :: LSAME @@ -464,7 +464,6 @@ RECURSIVE SUBROUTINE ZLAQZ0( WANTS, WANTQ, WANTZ, N, ILO, IHI, A, * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N )/ULP ) diff --git a/SRC/zlaqz2.f b/SRC/zlaqz2.f index 2e94e6dc49..0256512241 100644 --- a/SRC/zlaqz2.f +++ b/SRC/zlaqz2.f @@ -258,7 +258,7 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, COMPLEX*16 :: S, S1, TEMP * External Functions - EXTERNAL :: XERBLA, ZLAQZ0, ZLAQZ1, DLABAD, ZLACPY, ZLASET, ZGEMM, + EXTERNAL :: XERBLA, ZLAQZ0, ZLAQZ1, ZLACPY, ZLASET, ZGEMM, $ ZTGEXC, ZLARTG, ZROT DOUBLE PRECISION, EXTERNAL :: DLAMCH @@ -297,7 +297,6 @@ RECURSIVE SUBROUTINE ZLAQZ2( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULP = DLAMCH( 'PRECISION' ) SMLNUM = SAFMIN*( DBLE( N )/ULP ) diff --git a/SRC/zlaqz3.f b/SRC/zlaqz3.f index 9e589cb67e..5c1abb52fc 100644 --- a/SRC/zlaqz3.f +++ b/SRC/zlaqz3.f @@ -232,8 +232,7 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, COMPLEX*16 :: TEMP, TEMP2, TEMP3, S * External Functions - EXTERNAL :: XERBLA, DLABAD, ZLASET, ZLARTG, ZROT, ZLAQZ1, ZGEMM, - $ ZLACPY + EXTERNAL :: XERBLA, ZLASET, ZLARTG, ZROT, ZLAQZ1, ZGEMM, ZLACPY DOUBLE PRECISION, EXTERNAL :: DLAMCH INFO = 0 @@ -260,7 +259,6 @@ SUBROUTINE ZLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NSHIFTS, * Get machine constants SAFMIN = DLAMCH( 'SAFE MINIMUM' ) SAFMAX = ONE/SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) IF ( ILO .GE. IHI ) THEN RETURN diff --git a/SRC/zlatps.f b/SRC/zlatps.f index b22e42f6c1..29fcb6c185 100644 --- a/SRC/zlatps.f +++ b/SRC/zlatps.f @@ -266,7 +266,7 @@ SUBROUTINE ZLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, $ ZDOTU, ZLADIV * .. * .. External Subroutines .. - EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTPSV, DLABAD + EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTPSV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN @@ -315,7 +315,6 @@ SUBROUTINE ZLATPS( UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, * SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM / DLAMCH( 'Precision' ) BIGNUM = ONE / SMLNUM SCALE = ONE diff --git a/SRC/ztgevc.f b/SRC/ztgevc.f index 23bd36ddb1..793eabc5bf 100644 --- a/SRC/ztgevc.f +++ b/SRC/ztgevc.f @@ -259,7 +259,7 @@ SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, EXTERNAL LSAME, DLAMCH, ZLADIV * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGEMV + EXTERNAL XERBLA, ZGEMV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN @@ -367,7 +367,6 @@ SUBROUTINE ZTGEVC( SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, * SAFMIN = DLAMCH( 'Safe minimum' ) BIG = ONE / SAFMIN - CALL DLABAD( SAFMIN, BIG ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMALL = SAFMIN*N / ULP BIG = ONE / SMALL diff --git a/SRC/ztgsna.f b/SRC/ztgsna.f index 11743eb2df..e76b4b1547 100644 --- a/SRC/ztgsna.f +++ b/SRC/ztgsna.f @@ -348,7 +348,7 @@ SUBROUTINE ZTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, EXTERNAL LSAME, DLAMCH, DLAPY2, DZNRM2, ZDOTC * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZGEMV, ZLACPY, ZTGEXC, ZTGSYL + EXTERNAL XERBLA, ZGEMV, ZLACPY, ZTGEXC, ZTGSYL * .. * .. Intrinsic Functions .. INTRINSIC ABS, DCMPLX, MAX @@ -428,7 +428,6 @@ SUBROUTINE ZTGSNA( JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) KS = 0 DO 20 K = 1, N * diff --git a/SRC/ztrevc.f b/SRC/ztrevc.f index 38411757dc..67fc13dfcf 100644 --- a/SRC/ztrevc.f +++ b/SRC/ztrevc.f @@ -253,7 +253,7 @@ SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, IZAMAX, DLAMCH, DZASUM * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS, DLABAD + EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX @@ -319,7 +319,6 @@ SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) * diff --git a/SRC/ztrevc3.f b/SRC/ztrevc3.f index 6300e80aec..64552ddd6b 100644 --- a/SRC/ztrevc3.f +++ b/SRC/ztrevc3.f @@ -283,7 +283,7 @@ SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * .. * .. External Subroutines .. EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS, - $ ZGEMM, DLABAD, ZLASET, ZLACPY + $ ZGEMM, ZLASET, ZLACPY * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, CONJG, DIMAG, MAX @@ -371,7 +371,6 @@ SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) SMLNUM = UNFL*( N / ULP ) * diff --git a/SRC/ztrsna.f b/SRC/ztrsna.f index eaa2ef7175..1b947ce101 100644 --- a/SRC/ztrsna.f +++ b/SRC/ztrsna.f @@ -288,8 +288,7 @@ SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EXTERNAL LSAME, IZAMAX, DLAMCH, DZNRM2, ZDOTC * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS, ZTREXC, - $ DLABAD + EXTERNAL XERBLA, ZDRSCL, ZLACN2, ZLACPY, ZLATRS, ZTREXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, MAX @@ -368,7 +367,6 @@ SUBROUTINE ZTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * KS = 1 DO 50 K = 1, N diff --git a/SRC/ztrsyl.f b/SRC/ztrsyl.f index 27e21dd9d6..1a493d30be 100644 --- a/SRC/ztrsyl.f +++ b/SRC/ztrsyl.f @@ -191,7 +191,7 @@ SUBROUTINE ZTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EXTERNAL LSAME, DLAMCH, ZLANGE, ZDOTC, ZDOTU, ZLADIV * .. * .. External Subroutines .. - EXTERNAL DLABAD, XERBLA, ZDSCAL + EXTERNAL XERBLA, ZDSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN @@ -237,7 +237,6 @@ SUBROUTINE ZTRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM*DBLE( M*N ) / EPS BIGNUM = ONE / SMLNUM SMIN = MAX( SMLNUM, EPS*ZLANGE( 'M', M, M, A, LDA, DUM ),