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 ), diff --git a/TESTING/EIG/cchkbd.f b/TESTING/EIG/cchkbd.f index 12fc0d3329..afcdf87608 100644 --- a/TESTING/EIG/cchkbd.f +++ b/TESTING/EIG/cchkbd.f @@ -465,8 +465,8 @@ SUBROUTINE CCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, * .. External Subroutines .. EXTERNAL ALASUM, CBDSQR, CBDT01, CBDT02, CBDT03, $ CGEBRD, CGEMM, CLACPY, CLASET, CLATMR, - $ CLATMS, CUNGBR, CUNT01, SCOPY, SLABAD, - $ SLAHD2, SSVDCH, XERBLA + $ CLATMS, CUNGBR, CUNT01, SCOPY, SLAHD2, + $ SSVDCH, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT @@ -548,7 +548,6 @@ SUBROUTINE CCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, NTEST = 0 UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/cchkgg.f b/TESTING/EIG/cchkgg.f index 8938bb6579..b4ba6724d9 100644 --- a/TESTING/EIG/cchkgg.f +++ b/TESTING/EIG/cchkgg.f @@ -560,8 +560,8 @@ SUBROUTINE CCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL CGEQR2, CGET51, CGET52, CGGHRD, CHGEQZ, CLACPY, - $ CLARFG, CLASET, CLATM4, CTGEVC, CUNM2R, SLABAD, - $ SLASUM, XERBLA + $ CLARFG, CLASET, CLATM4, CTGEVC, CUNM2R, SLASUM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, MAX, MIN, REAL, SIGN @@ -639,7 +639,6 @@ SUBROUTINE CCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/cchkhs.f b/TESTING/EIG/cchkhs.f index 6c6430d5f8..4b80d28151 100644 --- a/TESTING/EIG/cchkhs.f +++ b/TESTING/EIG/cchkhs.f @@ -473,7 +473,7 @@ SUBROUTINE CCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL CCOPY, CGEHRD, CGEMM, CGET10, CGET22, CHSEIN, $ CHSEQR, CHST01, CLACPY, CLASET, CLATME, CLATMR, $ CLATMS, CTREVC, CTREVC3, CUNGHR, CUNMHR, - $ SLABAD, SLAFTS, SLASUM, XERBLA + $ SLAFTS, SLASUM, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SQRT @@ -533,7 +533,6 @@ SUBROUTINE CCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/cchkst.f b/TESTING/EIG/cchkst.f index 95747d0519..96af7d654e 100644 --- a/TESTING/EIG/cchkst.f +++ b/TESTING/EIG/cchkst.f @@ -665,8 +665,7 @@ SUBROUTINE CCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL CCOPY, CHET21, CHETRD, CHPT21, CHPTRD, CLACPY, $ CLASET, CLATMR, CLATMS, CPTEQR, CSTEDC, CSTEMR, $ CSTEIN, CSTEQR, CSTT21, CSTT22, CUNGTR, CUPGTR, - $ SCOPY, SLABAD, SLASUM, SSTEBZ, SSTECH, SSTERF, - $ XERBLA + $ SCOPY, SLASUM, SSTEBZ, SSTECH, SSTERF, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, INT, LOG, MAX, MIN, REAL, SQRT @@ -733,7 +732,6 @@ SUBROUTINE CCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/cchkst2stg.f b/TESTING/EIG/cchkst2stg.f index e4deb8ac85..21aceed734 100644 --- a/TESTING/EIG/cchkst2stg.f +++ b/TESTING/EIG/cchkst2stg.f @@ -683,10 +683,10 @@ SUBROUTINE CCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, SLAMCH, SLARND, SSXT1 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLABAD, SLASUM, SSTEBZ, SSTECH, SSTERF, - $ XERBLA, CCOPY, CHET21, CHETRD, CHPT21, CHPTRD, - $ CLACPY, CLASET, CLATMR, CLATMS, CPTEQR, CSTEDC, - $ CSTEMR, CSTEIN, CSTEQR, CSTT21, CSTT22, CUNGTR, + EXTERNAL SCOPY, SLASUM, SSTEBZ, SSTECH, SSTERF, XERBLA, + $ CCOPY, CHET21, CHETRD, CHPT21, CHPTRD, CLACPY, + $ CLASET, CLATMR, CLATMS, CPTEQR, CSTEDC, CSTEMR, + $ CSTEIN, CSTEQR, CSTT21, CSTT22, CUNGTR, $ CUPGTR, CHETRD_2STAGE, SLASET * .. * .. Intrinsic Functions .. @@ -754,7 +754,6 @@ SUBROUTINE CCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/cdrges.f b/TESTING/EIG/cdrges.f index b28b190f5f..3530981c62 100644 --- a/TESTING/EIG/cdrges.f +++ b/TESTING/EIG/cdrges.f @@ -435,7 +435,7 @@ SUBROUTINE CDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL ALASVM, CGET51, CGET54, CGGES, CLACPY, CLARFG, - $ CLASET, CLATM4, CUNM2R, SLABAD, XERBLA + $ CLASET, CLATM4, CUNM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CONJG, MAX, MIN, REAL, SIGN @@ -533,7 +533,6 @@ SUBROUTINE CDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = SLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/cdrges3.f b/TESTING/EIG/cdrges3.f index dd1d9ed5c2..922251a945 100644 --- a/TESTING/EIG/cdrges3.f +++ b/TESTING/EIG/cdrges3.f @@ -436,7 +436,7 @@ SUBROUTINE CDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL ALASVM, CGET51, CGET54, CGGES3, CLACPY, CLARFG, - $ CLASET, CLATM4, CUNM2R, SLABAD, XERBLA + $ CLASET, CLATM4, CUNM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CONJG, MAX, MIN, REAL, SIGN @@ -534,7 +534,6 @@ SUBROUTINE CDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = SLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/cdrgev.f b/TESTING/EIG/cdrgev.f index 0e4d131c8a..b9ff39dce0 100644 --- a/TESTING/EIG/cdrgev.f +++ b/TESTING/EIG/cdrgev.f @@ -452,7 +452,7 @@ SUBROUTINE CDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL ALASVM, CGET52, CGGEV, CLACPY, CLARFG, CLASET, - $ CLATM4, CUNM2R, SLABAD, XERBLA + $ CLATM4, CUNM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, MAX, MIN, REAL, SIGN @@ -546,7 +546,6 @@ SUBROUTINE CDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = SLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/cdrgev3.f b/TESTING/EIG/cdrgev3.f index fbb74cf70c..07b7a1f964 100644 --- a/TESTING/EIG/cdrgev3.f +++ b/TESTING/EIG/cdrgev3.f @@ -452,7 +452,7 @@ SUBROUTINE CDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL ALASVM, CGET52, CGGEV3, CLACPY, CLARFG, CLASET, - $ CLATM4, CUNM2R, SLABAD, XERBLA + $ CLATM4, CUNM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CONJG, MAX, MIN, REAL, SIGN @@ -546,7 +546,6 @@ SUBROUTINE CDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = SLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/cdrgsx.f b/TESTING/EIG/cdrgsx.f index c5baeef5ee..ef6d66e147 100644 --- a/TESTING/EIG/cdrgsx.f +++ b/TESTING/EIG/cdrgsx.f @@ -395,7 +395,7 @@ SUBROUTINE CDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, * .. * .. External Subroutines .. EXTERNAL ALASVM, CGESVD, CGET51, CGGESX, CLACPY, CLAKF2, - $ CLASET, CLATM5, SLABAD, XERBLA + $ CLASET, CLATM5, XERBLA * .. * .. Scalars in Common .. LOGICAL FS @@ -478,7 +478,6 @@ SUBROUTINE CDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, ULPINV = ONE / ULP SMLNUM = SLAMCH( 'S' ) / ULP BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) THRSH2 = TEN*THRESH NTESTT = 0 NERRS = 0 diff --git a/TESTING/EIG/cdrves.f b/TESTING/EIG/cdrves.f index 81a44a5836..f12f742fb2 100644 --- a/TESTING/EIG/cdrves.f +++ b/TESTING/EIG/cdrves.f @@ -438,7 +438,7 @@ SUBROUTINE CDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL CGEES, CHST01, CLACPY, CLATME, CLATMR, CLATMS, - $ CLASET, SLABAD, SLASUM, XERBLA + $ CLASET, SLASUM, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, MAX, MIN, SQRT @@ -507,7 +507,6 @@ SUBROUTINE CDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/cdrvev.f b/TESTING/EIG/cdrvev.f index 6a834b6d92..6957f9911d 100644 --- a/TESTING/EIG/cdrvev.f +++ b/TESTING/EIG/cdrvev.f @@ -443,7 +443,7 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL CGEEV, CGET22, CLACPY, CLATME, CLATMR, CLATMS, - $ CLASET, SLABAD, SLASUM, XERBLA + $ CLASET, SLASUM, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, CMPLX, MAX, MIN, REAL, SQRT @@ -515,7 +515,6 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/cdrvsg.f b/TESTING/EIG/cdrvsg.f index d15b39d01f..9b3e364dd8 100644 --- a/TESTING/EIG/cdrvsg.f +++ b/TESTING/EIG/cdrvsg.f @@ -420,7 +420,7 @@ SUBROUTINE CDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. External Subroutines .. EXTERNAL CHBGV, CHBGVD, CHBGVX, CHEGV, CHEGVD, CHEGVX, $ CHPGV, CHPGVD, CHPGVX, CLACPY, CLASET, CLATMR, - $ CLATMS, CSGT01, SLABAD, SLAFTS, SLASUM, XERBLA + $ CLATMS, CSGT01, SLAFTS, SLASUM, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SQRT @@ -481,7 +481,6 @@ SUBROUTINE CDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/cdrvsg2stg.f b/TESTING/EIG/cdrvsg2stg.f index 8b85537739..048804a00b 100644 --- a/TESTING/EIG/cdrvsg2stg.f +++ b/TESTING/EIG/cdrvsg2stg.f @@ -426,7 +426,7 @@ SUBROUTINE CDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL LSAME, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLAFTS, SLASUM, XERBLA, CHBGV, CHBGVD, + EXTERNAL SLAFTS, SLASUM, XERBLA, CHBGV, CHBGVD, $ CHBGVX, CHEGV, CHEGVD, CHEGVX, CHPGV, CHPGVD, $ CHPGVX, CLACPY, CLASET, CLATMR, CLATMS, CSGT01, $ CHEGV_2STAGE @@ -490,7 +490,6 @@ SUBROUTINE CDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/cdrvst.f b/TESTING/EIG/cdrvst.f index 9c129c0e88..92ddd5d43b 100644 --- a/TESTING/EIG/cdrvst.f +++ b/TESTING/EIG/cdrvst.f @@ -393,8 +393,8 @@ SUBROUTINE CDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. External Subroutines .. EXTERNAL ALASVM, CHBEV, CHBEVD, CHBEVX, CHEEV, CHEEVD, $ CHEEVR, CHEEVX, CHET21, CHET22, CHPEV, CHPEVD, - $ CHPEVX, CLACPY, CLASET, CLATMR, CLATMS, SLABAD, - $ SLAFTS, XERBLA + $ CHPEVX, CLACPY, CLASET, CLATMR, CLATMS, SLAFTS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, LOG, MAX, MIN, REAL, SQRT @@ -451,7 +451,6 @@ SUBROUTINE CDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/cdrvst2stg.f b/TESTING/EIG/cdrvst2stg.f index 954c7fb87a..66d39f054e 100644 --- a/TESTING/EIG/cdrvst2stg.f +++ b/TESTING/EIG/cdrvst2stg.f @@ -391,7 +391,7 @@ SUBROUTINE CDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH, SLARND, SSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASVM, SLABAD, SLAFTS, XERBLA, CHBEV, CHBEVD, + EXTERNAL ALASVM, SLAFTS, XERBLA, CHBEV, CHBEVD, $ CHBEVX, CHEEV, CHEEVD, CHEEVR, CHEEVX, CHET21, $ CHET22, CHPEV, CHPEVD, CHPEVX, CLACPY, CLASET, $ CHEEVD_2STAGE, CHEEVR_2STAGE, CHEEVX_2STAGE, @@ -453,7 +453,6 @@ SUBROUTINE CDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/cdrvsx.f b/TESTING/EIG/cdrvsx.f index 0265ff2715..2f34cf83ca 100644 --- a/TESTING/EIG/cdrvsx.f +++ b/TESTING/EIG/cdrvsx.f @@ -492,7 +492,7 @@ SUBROUTINE CDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL CGET24, CLATME, CLATMR, CLATMS, CLASET, SLABAD, + EXTERNAL CGET24, CLATME, CLATMR, CLATMS, CLASET, $ SLASUM, XERBLA * .. * .. Intrinsic Functions .. @@ -567,7 +567,6 @@ SUBROUTINE CDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/cdrvvx.f b/TESTING/EIG/cdrvvx.f index f1f5a0bace..1d4cee29d9 100644 --- a/TESTING/EIG/cdrvvx.f +++ b/TESTING/EIG/cdrvvx.f @@ -548,8 +548,8 @@ SUBROUTINE CDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL CGET23, CLATME, CLATMR, CLATMS, CLASET, SLABAD, - $ SLASUM, XERBLA + EXTERNAL CGET23, CLATME, CLATMR, CLATMS, CLASET, SLASUM, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, MAX, MIN, SQRT @@ -624,7 +624,6 @@ SUBROUTINE CDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/cget35.f b/TESTING/EIG/cget35.f index 4f03ab9eee..1d92c4fc59 100644 --- a/TESTING/EIG/cget35.f +++ b/TESTING/EIG/cget35.f @@ -134,7 +134,6 @@ SUBROUTINE CGET35( RMAX, LMAX, NINFO, KNT, NIN ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/cget37.f b/TESTING/EIG/cget37.f index 44d4580d6f..5eae323203 100644 --- a/TESTING/EIG/cget37.f +++ b/TESTING/EIG/cget37.f @@ -132,7 +132,7 @@ SUBROUTINE CGET37( RMAX, LMAX, NINFO, KNT, NIN ) * .. * .. External Subroutines .. EXTERNAL CCOPY, CGEHRD, CHSEQR, CLACPY, CSSCAL, CTREVC, - $ CTRSNA, SCOPY, SLABAD, SSCAL + $ CTRSNA, SCOPY, SSCAL * .. * .. Intrinsic Functions .. INTRINSIC AIMAG, MAX, REAL, SQRT @@ -142,7 +142,6 @@ SUBROUTINE CGET37( RMAX, LMAX, NINFO, KNT, NIN ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/cget38.f b/TESTING/EIG/cget38.f index 9925f3fd70..9eccbc857d 100644 --- a/TESTING/EIG/cget38.f +++ b/TESTING/EIG/cget38.f @@ -136,7 +136,7 @@ SUBROUTINE CGET38( RMAX, LMAX, NINFO, KNT, NIN ) * .. * .. External Subroutines .. EXTERNAL CGEHRD, CHSEQR, CHST01, CLACPY, CSSCAL, CTRSEN, - $ CUNGHR, SLABAD + $ CUNGHR * .. * .. Intrinsic Functions .. INTRINSIC AIMAG, MAX, REAL, SQRT @@ -146,7 +146,6 @@ SUBROUTINE CGET38( RMAX, LMAX, NINFO, KNT, NIN ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/chst01.f b/TESTING/EIG/chst01.f index 286daee2c9..5be1bc4de9 100644 --- a/TESTING/EIG/chst01.f +++ b/TESTING/EIG/chst01.f @@ -166,7 +166,7 @@ SUBROUTINE CHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, EXTERNAL CLANGE, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CGEMM, CLACPY, CUNT01, SLABAD + EXTERNAL CGEMM, CLACPY, CUNT01 * .. * .. Intrinsic Functions .. INTRINSIC CMPLX, MAX, MIN @@ -184,7 +184,6 @@ SUBROUTINE CHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, UNFL = SLAMCH( 'Safe minimum' ) EPS = SLAMCH( 'Precision' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) SMLNUM = UNFL*N / EPS * * Test 1: Compute norm( A - Q*H*Q' ) / ( norm(A) * N * EPS ) diff --git a/TESTING/EIG/dchkbd.f b/TESTING/EIG/dchkbd.f index a24acfab2b..400075abdf 100644 --- a/TESTING/EIG/dchkbd.f +++ b/TESTING/EIG/dchkbd.f @@ -544,8 +544,8 @@ SUBROUTINE DCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, * .. External Subroutines .. EXTERNAL ALASUM, DBDSDC, DBDSQR, DBDSVDX, DBDT01, $ DBDT02, DBDT03, DBDT04, DCOPY, DGEBRD, - $ DGEMM, DLABAD, DLACPY, DLAHD2, DLASET, - $ DLATMR, DLATMS, DORGBR, DORT01, XERBLA + $ DGEMM, DLACPY, DLAHD2, DLASET, DLATMR, + $ DLATMS, DORGBR, DORT01, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT @@ -627,7 +627,6 @@ SUBROUTINE DCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, NTEST = 0 UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/dchkgg.f b/TESTING/EIG/dchkgg.f index 15e1360ea3..3dc9f9595e 100644 --- a/TESTING/EIG/dchkgg.f +++ b/TESTING/EIG/dchkgg.f @@ -561,9 +561,9 @@ SUBROUTINE DCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, DLANGE, DLARND * .. * .. External Subroutines .. - EXTERNAL DGEQR2, DGET51, DGET52, DGGHRD, DHGEQZ, DLABAD, - $ DLACPY, DLARFG, DLASET, DLASUM, DLATM4, DORM2R, - $ DTGEVC, XERBLA + EXTERNAL DGEQR2, DGET51, DGET52, DGGHRD, DHGEQZ, DLACPY, + $ DLARFG, DLASET, DLASUM, DLATM4, DORM2R, DTGEVC, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SIGN @@ -641,7 +641,6 @@ SUBROUTINE DCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/dchkhs.f b/TESTING/EIG/dchkhs.f index 79ba960086..2b0eb274a5 100644 --- a/TESTING/EIG/dchkhs.f +++ b/TESTING/EIG/dchkhs.f @@ -469,9 +469,9 @@ SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL DCOPY, DGEHRD, DGEMM, DGET10, DGET22, DHSEIN, - $ DHSEQR, DHST01, DLABAD, DLACPY, DLAFTS, DLASET, - $ DLASUM, DLATME, DLATMR, DLATMS, DORGHR, DORMHR, - $ DTREVC, DTREVC3, XERBLA + $ DHSEQR, DHST01, DLACPY, DLAFTS, DLASET, DLASUM, + $ DLATME, DLATMR, DLATMS, DORGHR, DORMHR, DTREVC, + $ DTREVC3, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SQRT @@ -531,7 +531,6 @@ SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/dchkst.f b/TESTING/EIG/dchkst.f index 2e04f68c53..dad0a7e32c 100644 --- a/TESTING/EIG/dchkst.f +++ b/TESTING/EIG/dchkst.f @@ -645,10 +645,10 @@ SUBROUTINE DCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DLACPY, DLASET, DLASUM, DLATMR, - $ DLATMS, DOPGTR, DORGTR, DPTEQR, DSPT21, DSPTRD, - $ DSTEBZ, DSTECH, DSTEDC, DSTEMR, DSTEIN, DSTEQR, - $ DSTERF, DSTT21, DSTT22, DSYT21, DSYTRD, XERBLA + EXTERNAL DCOPY, DLACPY, DLASET, DLASUM, DLATMR, DLATMS, + $ DOPGTR, DORGTR, DPTEQR, DSPT21, DSPTRD, DSTEBZ, + $ DSTECH, DSTEDC, DSTEMR, DSTEIN, DSTEQR, DSTERF, + $ DSTT21, DSTT22, DSYT21, DSYTRD, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN, SQRT @@ -715,7 +715,6 @@ SUBROUTINE DCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/dchkst2stg.f b/TESTING/EIG/dchkst2stg.f index 2c98b802d3..e33c908f7a 100644 --- a/TESTING/EIG/dchkst2stg.f +++ b/TESTING/EIG/dchkst2stg.f @@ -666,10 +666,10 @@ SUBROUTINE DCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DLACPY, DLASET, DLASUM, DLATMR, - $ DLATMS, DOPGTR, DORGTR, DPTEQR, DSPT21, DSPTRD, - $ DSTEBZ, DSTECH, DSTEDC, DSTEMR, DSTEIN, DSTEQR, - $ DSTERF, DSTT21, DSTT22, DSYT21, DSYTRD, XERBLA, + EXTERNAL DCOPY, DLACPY, DLASET, DLASUM, DLATMR, DLATMS, + $ DOPGTR, DORGTR, DPTEQR, DSPT21, DSPTRD, DSTEBZ, + $ DSTECH, DSTEDC, DSTEMR, DSTEIN, DSTEQR, DSTERF, + $ DSTT21, DSTT22, DSYT21, DSYTRD, XERBLA, $ DSYTRD_2STAGE * .. * .. Intrinsic Functions .. @@ -737,7 +737,6 @@ SUBROUTINE DCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/ddrges.f b/TESTING/EIG/ddrges.f index abb10547a0..4dc1bcefbf 100644 --- a/TESTING/EIG/ddrges.f +++ b/TESTING/EIG/ddrges.f @@ -451,8 +451,8 @@ SUBROUTINE DDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLCTES, ILAENV, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DGET51, DGET53, DGET54, DGGES, DLABAD, - $ DLACPY, DLARFG, DLASET, DLATM4, DORM2R, XERBLA + EXTERNAL ALASVM, DGET51, DGET53, DGET54, DGGES, DLACPY, + $ DLARFG, DLASET, DLATM4, DORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SIGN @@ -541,7 +541,6 @@ SUBROUTINE DDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/ddrges3.f b/TESTING/EIG/ddrges3.f index 770ae09c07..ae62800eeb 100644 --- a/TESTING/EIG/ddrges3.f +++ b/TESTING/EIG/ddrges3.f @@ -451,8 +451,8 @@ SUBROUTINE DDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLCTES, ILAENV, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DGET51, DGET53, DGET54, DGGES3, DLABAD, - $ DLACPY, DLARFG, DLASET, DLATM4, DORM2R, XERBLA + EXTERNAL ALASVM, DGET51, DGET53, DGET54, DGGES3, DLACPY, + $ DLARFG, DLASET, DLATM4, DORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SIGN @@ -541,7 +541,6 @@ SUBROUTINE DDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/ddrgev.f b/TESTING/EIG/ddrgev.f index 536ab36e1d..bafd8c2d25 100644 --- a/TESTING/EIG/ddrgev.f +++ b/TESTING/EIG/ddrgev.f @@ -455,7 +455,7 @@ SUBROUTINE DDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DGET52, DGGEV, DLABAD, DLACPY, DLARFG, + EXTERNAL ALASVM, DGET52, DGGEV, DLACPY, DLARFG, $ DLASET, DLATM4, DORM2R, XERBLA * .. * .. Intrinsic Functions .. @@ -546,7 +546,6 @@ SUBROUTINE DDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/ddrgev3.f b/TESTING/EIG/ddrgev3.f index 20a64361cc..ac6944634b 100644 --- a/TESTING/EIG/ddrgev3.f +++ b/TESTING/EIG/ddrgev3.f @@ -455,8 +455,8 @@ SUBROUTINE DDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DGET52, DGGEV3, DLABAD, DLACPY, DLARFG, - $ DLASET, DLATM4, DORM2R, XERBLA + EXTERNAL ALASVM, DGET52, DGGEV3, DLACPY, DLARFG, DLASET, + $ DLATM4, DORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SIGN @@ -546,7 +546,6 @@ SUBROUTINE DDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/ddrgsx.f b/TESTING/EIG/ddrgsx.f index b3f5e23f4a..b7efc1e633 100644 --- a/TESTING/EIG/ddrgsx.f +++ b/TESTING/EIG/ddrgsx.f @@ -400,7 +400,7 @@ SUBROUTINE DDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, AI, EXTERNAL DLCTSX, ILAENV, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL ALASVM, DGESVD, DGET51, DGET53, DGGESX, DLABAD, + EXTERNAL ALASVM, DGESVD, DGET51, DGET53, DGGESX, $ DLACPY, DLAKF2, DLASET, DLATM5, XERBLA * .. * .. Intrinsic Functions .. @@ -478,7 +478,6 @@ SUBROUTINE DDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, AI, ULPINV = ONE / ULP SMLNUM = DLAMCH( 'S' ) / ULP BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) THRSH2 = TEN*THRESH NTESTT = 0 NERRS = 0 diff --git a/TESTING/EIG/ddrvbd.f b/TESTING/EIG/ddrvbd.f index ce83234bff..0e3e2b4612 100644 --- a/TESTING/EIG/ddrvbd.f +++ b/TESTING/EIG/ddrvbd.f @@ -420,8 +420,8 @@ SUBROUTINE DDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL ALASVM, DBDT01, DGEJSV, DGESDD, DGESVD, - $ DGESVDQ, DGESVDX, DGESVJ, DLABAD, DLACPY, - $ DLASET, DLATMS, DORT01, DORT03, XERBLA + $ DGESVDQ, DGESVDX, DGESVJ, DLACPY, DLASET, + $ DLATMS, DORT01, DORT03, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN @@ -497,7 +497,6 @@ SUBROUTINE DDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, NTEST = 0 UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) RTUNFL = SQRT( UNFL ) ULPINV = ONE / ULP diff --git a/TESTING/EIG/ddrves.f b/TESTING/EIG/ddrves.f index d2c2218b0b..594158d989 100644 --- a/TESTING/EIG/ddrves.f +++ b/TESTING/EIG/ddrves.f @@ -444,8 +444,8 @@ SUBROUTINE DDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DSLECT, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DGEES, DHST01, DLABAD, DLACPY, DLASET, DLASUM, - $ DLATME, DLATMR, DLATMS, XERBLA + EXTERNAL DGEES, DHST01, DLACPY, DLASET, DLASUM, DLATME, + $ DLATMR, DLATMS, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SIGN, SQRT @@ -514,7 +514,6 @@ SUBROUTINE DDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/ddrvev.f b/TESTING/EIG/ddrvev.f index 3b39fa977c..402022a823 100644 --- a/TESTING/EIG/ddrvev.f +++ b/TESTING/EIG/ddrvev.f @@ -452,7 +452,7 @@ SUBROUTINE DDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, DLAPY2, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DGEEV, DGET22, DLABAD, DLACPY, DLASET, DLASUM, + EXTERNAL DGEEV, DGET22, DLACPY, DLASET, DLASUM, $ DLATME, DLATMR, DLATMS, XERBLA * .. * .. Intrinsic Functions .. @@ -525,7 +525,6 @@ SUBROUTINE DDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/ddrvsg.f b/TESTING/EIG/ddrvsg.f index 2e9d3c643e..4327246e57 100644 --- a/TESTING/EIG/ddrvsg.f +++ b/TESTING/EIG/ddrvsg.f @@ -399,7 +399,7 @@ SUBROUTINE DDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL LSAME, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLACPY, DLAFTS, DLASET, DLASUM, DLATMR, + EXTERNAL DLACPY, DLAFTS, DLASET, DLASUM, DLATMR, $ DLATMS, DSBGV, DSBGVD, DSBGVX, DSGT01, DSPGV, $ DSPGVD, DSPGVX, DSYGV, DSYGVD, DSYGVX, XERBLA * .. @@ -460,7 +460,6 @@ SUBROUTINE DDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/ddrvsg2stg.f b/TESTING/EIG/ddrvsg2stg.f index 196c6b48e6..a48dc8c192 100644 --- a/TESTING/EIG/ddrvsg2stg.f +++ b/TESTING/EIG/ddrvsg2stg.f @@ -408,7 +408,7 @@ SUBROUTINE DDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL LSAME, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLACPY, DLAFTS, DLASET, DLASUM, DLATMR, + EXTERNAL DLACPY, DLAFTS, DLASET, DLASUM, DLATMR, $ DLATMS, DSBGV, DSBGVD, DSBGVX, DSGT01, DSPGV, $ DSPGVD, DSPGVX, DSYGV, DSYGVD, DSYGVX, XERBLA, $ DSYGV_2STAGE @@ -470,7 +470,6 @@ SUBROUTINE DDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/ddrvst.f b/TESTING/EIG/ddrvst.f index a25077018b..7d34ca18e1 100644 --- a/TESTING/EIG/ddrvst.f +++ b/TESTING/EIG/ddrvst.f @@ -502,11 +502,11 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, DLACPY, DLAFTS, DLASET, DLATMR, - $ DLATMS, DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD, - $ DSPEVX, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21, - $ DSTT22, DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21, - $ DSYT22, XERBLA + EXTERNAL ALASVM, DLACPY, DLAFTS, DLASET, DLATMR, DLATMS, + $ DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD, DSPEVX, + $ DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21, DSTT22, + $ DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21, DSYT22, + $ XERBLA * .. * .. Scalars in Common .. CHARACTER*32 SRNAMT @@ -574,7 +574,6 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/ddrvst2stg.f b/TESTING/EIG/ddrvst2stg.f index c9a2632bbf..1976712777 100644 --- a/TESTING/EIG/ddrvst2stg.f +++ b/TESTING/EIG/ddrvst2stg.f @@ -502,7 +502,7 @@ SUBROUTINE DDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, DLACPY, DLAFTS, DLASET, DLATMR, + EXTERNAL ALASVM, DLACPY, DLAFTS, DLASET, DLATMR, $ DLATMS, DSBEV, DSBEVD, DSBEVX, DSPEV, DSPEVD, $ DSPEVX, DSTEV, DSTEVD, DSTEVR, DSTEVX, DSTT21, $ DSTT22, DSYEV, DSYEVD, DSYEVR, DSYEVX, DSYT21, @@ -577,7 +577,6 @@ SUBROUTINE DDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/ddrvsx.f b/TESTING/EIG/ddrvsx.f index c032a4a0c8..8954f24600 100644 --- a/TESTING/EIG/ddrvsx.f +++ b/TESTING/EIG/ddrvsx.f @@ -508,7 +508,7 @@ SUBROUTINE DDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DGET24, DLABAD, DLASET, DLASUM, DLATME, DLATMR, + EXTERNAL DGET24, DLASET, DLASUM, DLATME, DLATMR, $ DLATMS, XERBLA * .. * .. Intrinsic Functions .. @@ -583,7 +583,6 @@ SUBROUTINE DDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/ddrvvx.f b/TESTING/EIG/ddrvvx.f index cbb78d2b6e..0ec6bb5ed1 100644 --- a/TESTING/EIG/ddrvvx.f +++ b/TESTING/EIG/ddrvvx.f @@ -568,8 +568,8 @@ SUBROUTINE DDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DGET23, DLABAD, DLASET, DLASUM, DLATME, DLATMR, - $ DLATMS, XERBLA + EXTERNAL DGET23, DLASET, DLASUM, DLATME, DLATMR, DLATMS, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -644,7 +644,6 @@ SUBROUTINE DDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/dget31.f b/TESTING/EIG/dget31.f index d1e83114bb..511b413be6 100644 --- a/TESTING/EIG/dget31.f +++ b/TESTING/EIG/dget31.f @@ -130,7 +130,7 @@ SUBROUTINE DGET31( RMAX, LMAX, NINFO, KNT ) EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLALN2 + EXTERNAL DLALN2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -146,7 +146,6 @@ SUBROUTINE DGET31( RMAX, LMAX, NINFO, KNT ) UNFL = DLAMCH( 'U' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/dget32.f b/TESTING/EIG/dget32.f index faf1773bbd..13d8a7494f 100644 --- a/TESTING/EIG/dget32.f +++ b/TESTING/EIG/dget32.f @@ -114,7 +114,7 @@ SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT ) EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASY2 + EXTERNAL DLASY2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -131,7 +131,6 @@ SUBROUTINE DGET32( RMAX, LMAX, NINFO, KNT ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/dget33.f b/TESTING/EIG/dget33.f index c4f3b69ce2..7b6454b5ac 100644 --- a/TESTING/EIG/dget33.f +++ b/TESTING/EIG/dget33.f @@ -105,7 +105,7 @@ SUBROUTINE DGET33( RMAX, LMAX, NINFO, KNT ) EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLANV2 + EXTERNAL DLANV2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SIGN @@ -117,7 +117,6 @@ SUBROUTINE DGET33( RMAX, LMAX, NINFO, KNT ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/dget34.f b/TESTING/EIG/dget34.f index 67f0df99fd..cfc9f3aabc 100644 --- a/TESTING/EIG/dget34.f +++ b/TESTING/EIG/dget34.f @@ -116,7 +116,7 @@ SUBROUTINE DGET34( RMAX, LMAX, NINFO, KNT ) EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DCOPY, DHST01, DLABAD, DLAEXC + EXTERNAL DCOPY, DHST01, DLAEXC * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, SIGN, SQRT @@ -128,7 +128,6 @@ SUBROUTINE DGET34( RMAX, LMAX, NINFO, KNT ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/dget35.f b/TESTING/EIG/dget35.f index a7908fca24..4f1d4ea718 100644 --- a/TESTING/EIG/dget35.f +++ b/TESTING/EIG/dget35.f @@ -110,7 +110,7 @@ SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT ) EXTERNAL DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLABAD, DTRSYL + EXTERNAL DGEMM, DTRSYL * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, SIN, SQRT @@ -133,7 +133,6 @@ SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' )*FOUR / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/dget37.f b/TESTING/EIG/dget37.f index fbdf50be22..552aa5323d 100644 --- a/TESTING/EIG/dget37.f +++ b/TESTING/EIG/dget37.f @@ -131,8 +131,8 @@ SUBROUTINE DGET37( RMAX, LMAX, NINFO, KNT, NIN ) EXTERNAL DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEHRD, DHSEQR, DLABAD, DLACPY, DSCAL, - $ DTREVC, DTRSNA + EXTERNAL DCOPY, DGEHRD, DHSEQR, DLACPY, DSCAL, DTREVC, + $ DTRSNA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, SQRT @@ -142,7 +142,6 @@ SUBROUTINE DGET37( RMAX, LMAX, NINFO, KNT, NIN ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/dget38.f b/TESTING/EIG/dget38.f index a0fb6daec0..7cc910039e 100644 --- a/TESTING/EIG/dget38.f +++ b/TESTING/EIG/dget38.f @@ -134,8 +134,8 @@ SUBROUTINE DGET38( RMAX, LMAX, NINFO, KNT, NIN ) EXTERNAL DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEHRD, DHSEQR, DHST01, DLABAD, DLACPY, - $ DORGHR, DSCAL, DTRSEN + EXTERNAL DCOPY, DGEHRD, DHSEQR, DHST01, DLACPY, DORGHR, + $ DSCAL, DTRSEN * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, SQRT @@ -145,7 +145,6 @@ SUBROUTINE DGET38( RMAX, LMAX, NINFO, KNT, NIN ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/dget39.f b/TESTING/EIG/dget39.f index 773d39c71d..62137402ce 100644 --- a/TESTING/EIG/dget39.f +++ b/TESTING/EIG/dget39.f @@ -130,7 +130,7 @@ SUBROUTINE DGET39( RMAX, LMAX, NINFO, KNT ) EXTERNAL IDAMAX, DASUM, DDOT, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DGEMV, DLABAD, DLAQTR + EXTERNAL DCOPY, DGEMV, DLAQTR * .. * .. Intrinsic Functions .. INTRINSIC ABS, COS, DBLE, MAX, SIN, SQRT @@ -159,7 +159,6 @@ SUBROUTINE DGET39( RMAX, LMAX, NINFO, KNT ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/dhst01.f b/TESTING/EIG/dhst01.f index 79925881b0..1d87fc206d 100644 --- a/TESTING/EIG/dhst01.f +++ b/TESTING/EIG/dhst01.f @@ -159,7 +159,7 @@ SUBROUTINE DHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, EXTERNAL DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DGEMM, DLABAD, DLACPY, DORT01 + EXTERNAL DGEMM, DLACPY, DORT01 * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -177,7 +177,6 @@ SUBROUTINE DHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, UNFL = DLAMCH( 'Safe minimum' ) EPS = DLAMCH( 'Precision' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) SMLNUM = UNFL*N / EPS * * Test 1: Compute norm( A - Q*H*Q' ) / ( norm(A) * N * EPS ) diff --git a/TESTING/EIG/dlatb9.f b/TESTING/EIG/dlatb9.f index 70647889b4..87c0aacbf8 100644 --- a/TESTING/EIG/dlatb9.f +++ b/TESTING/EIG/dlatb9.f @@ -199,9 +199,6 @@ SUBROUTINE DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, * .. Intrinsic Functions .. INTRINSIC MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -219,11 +216,6 @@ SUBROUTINE DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, BADC1 = SQRT( BADC2 ) SMALL = DLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL DLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/EIG/schkbd.f b/TESTING/EIG/schkbd.f index ba19cddd2f..9c8adc71f1 100644 --- a/TESTING/EIG/schkbd.f +++ b/TESTING/EIG/schkbd.f @@ -544,8 +544,8 @@ SUBROUTINE SCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, * .. External Subroutines .. EXTERNAL ALASUM, SBDSDC, SBDSQR, SBDSVDX, SBDT01, $ SBDT02, SBDT03, SBDT04, SCOPY, SGEBRD, - $ SGEMM, SLABAD, SLACPY, SLAHD2, SLASET, - $ SLATMR, SLATMS, SORGBR, SORT01, XERBLA + $ SGEMM, SLACPY, SLAHD2, SLASET, SLATMR, + $ SLATMS, SORGBR, SORT01, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT @@ -627,7 +627,6 @@ SUBROUTINE SCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, NTEST = 0 UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/schkgg.f b/TESTING/EIG/schkgg.f index fff2a6c2e9..f0e5f35854 100644 --- a/TESTING/EIG/schkgg.f +++ b/TESTING/EIG/schkgg.f @@ -561,9 +561,9 @@ SUBROUTINE SCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH, SLANGE, SLARND * .. * .. External Subroutines .. - EXTERNAL SGEQR2, SGET51, SGET52, SGGHRD, SHGEQZ, SLABAD, - $ SLACPY, SLARFG, SLASET, SLASUM, SLATM4, SORM2R, - $ STGEVC, XERBLA + EXTERNAL SGEQR2, SGET51, SGET52, SGGHRD, SHGEQZ, SLACPY, + $ SLARFG, SLASET, SLASUM, SLATM4, SORM2R, STGEVC, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SIGN @@ -641,7 +641,6 @@ SUBROUTINE SCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/schkhs.f b/TESTING/EIG/schkhs.f index bf8eb1b409..f21137f17a 100644 --- a/TESTING/EIG/schkhs.f +++ b/TESTING/EIG/schkhs.f @@ -468,9 +468,9 @@ SUBROUTINE SCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL SCOPY, SGEHRD, SGEMM, SGET10, SGET22, SHSEIN, - $ SHSEQR, SHST01, SLABAD, SLACPY, SLAFTS, SLASET, - $ SLASUM, SLATME, SLATMR, SLATMS, SORGHR, SORMHR, - $ STREVC, STREVC3, XERBLA + $ SHSEQR, SHST01, SLACPY, SLAFTS, SLASET, SLASUM, + $ SLATME, SLATMR, SLATMS, SORGHR, SORMHR, STREVC, + $ STREVC3, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SQRT @@ -530,7 +530,6 @@ SUBROUTINE SCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/schkst.f b/TESTING/EIG/schkst.f index 10622d77a7..8e85eb737d 100644 --- a/TESTING/EIG/schkst.f +++ b/TESTING/EIG/schkst.f @@ -645,10 +645,10 @@ SUBROUTINE SCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, SLAMCH, SLARND, SSXT1 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLABAD, SLACPY, SLASET, SLASUM, SLATMR, - $ SLATMS, SOPGTR, SORGTR, SPTEQR, SSPT21, SSPTRD, - $ SSTEBZ, SSTECH, SSTEDC, SSTEMR, SSTEIN, SSTEQR, - $ SSTERF, SSTT21, SSTT22, SSYT21, SSYTRD, XERBLA + EXTERNAL SCOPY, SLACPY, SLASET, SLASUM, SLATMR, SLATMS, + $ SOPGTR, SORGTR, SPTEQR, SSPT21, SSPTRD, SSTEBZ, + $ SSTECH, SSTEDC, SSTEMR, SSTEIN, SSTEQR, SSTERF, + $ SSTT21, SSTT22, SSYT21, SSYTRD, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, INT, LOG, MAX, MIN, REAL, SQRT @@ -715,7 +715,6 @@ SUBROUTINE SCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/schkst2stg.f b/TESTING/EIG/schkst2stg.f index ac5a3fc393..33aa1926b0 100644 --- a/TESTING/EIG/schkst2stg.f +++ b/TESTING/EIG/schkst2stg.f @@ -666,10 +666,10 @@ SUBROUTINE SCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, SLAMCH, SLARND, SSXT1 * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLABAD, SLACPY, SLASET, SLASUM, SLATMR, - $ SLATMS, SOPGTR, SORGTR, SPTEQR, SSPT21, SSPTRD, - $ SSTEBZ, SSTECH, SSTEDC, SSTEMR, SSTEIN, SSTEQR, - $ SSTERF, SSTT21, SSTT22, SSYT21, SSYTRD, XERBLA, + EXTERNAL SCOPY, SLACPY, SLASET, SLASUM, SLATMR, SLATMS, + $ SOPGTR, SORGTR, SPTEQR, SSPT21, SSPTRD, SSTEBZ, + $ SSTECH, SSTEDC, SSTEMR, SSTEIN, SSTEQR, SSTERF, + $ SSTT21, SSTT22, SSYT21, SSYTRD, XERBLA, $ SSYTRD_2STAGE * .. * .. Intrinsic Functions .. @@ -737,7 +737,6 @@ SUBROUTINE SCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/sdrges.f b/TESTING/EIG/sdrges.f index 73d23125c2..bfeb7560a0 100644 --- a/TESTING/EIG/sdrges.f +++ b/TESTING/EIG/sdrges.f @@ -451,8 +451,8 @@ SUBROUTINE SDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLCTES, ILAENV, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, SGET51, SGET53, SGET54, SGGES, SLABAD, - $ SLACPY, SLARFG, SLASET, SLATM4, SORM2R, XERBLA + EXTERNAL ALASVM, SGET51, SGET53, SGET54, SGGES, SLACPY, + $ SLARFG, SLASET, SLATM4, SORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SIGN @@ -541,7 +541,6 @@ SUBROUTINE SDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/sdrges3.f b/TESTING/EIG/sdrges3.f index 9c82725789..3eab1fcb8b 100644 --- a/TESTING/EIG/sdrges3.f +++ b/TESTING/EIG/sdrges3.f @@ -451,8 +451,8 @@ SUBROUTINE SDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLCTES, ILAENV, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, SGET51, SGET53, SGET54, SGGES3, SLABAD, - $ SLACPY, SLARFG, SLASET, SLATM4, SORM2R, XERBLA + EXTERNAL ALASVM, SGET51, SGET53, SGET54, SGGES3, SLACPY, + $ SLARFG, SLASET, SLATM4, SORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SIGN @@ -541,7 +541,6 @@ SUBROUTINE SDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/sdrgev.f b/TESTING/EIG/sdrgev.f index 5254a97235..db1c1b3e76 100644 --- a/TESTING/EIG/sdrgev.f +++ b/TESTING/EIG/sdrgev.f @@ -455,7 +455,7 @@ SUBROUTINE SDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, SGET52, SGGEV, SLABAD, SLACPY, SLARFG, + EXTERNAL ALASVM, SGET52, SGGEV, SLACPY, SLARFG, $ SLASET, SLATM4, SORM2R, XERBLA * .. * .. Intrinsic Functions .. @@ -546,7 +546,6 @@ SUBROUTINE SDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/sdrgev3.f b/TESTING/EIG/sdrgev3.f index 1b1d82292c..9012c615a3 100644 --- a/TESTING/EIG/sdrgev3.f +++ b/TESTING/EIG/sdrgev3.f @@ -455,8 +455,8 @@ SUBROUTINE SDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, SGET52, SGGEV3, SLABAD, SLACPY, SLARFG, - $ SLASET, SLATM4, SORM2R, XERBLA + EXTERNAL ALASVM, SGET52, SGGEV3, SLACPY, SLARFG, SLASET, + $ SLATM4, SORM2R, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SIGN @@ -546,7 +546,6 @@ SUBROUTINE SDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL SLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/sdrgsx.f b/TESTING/EIG/sdrgsx.f index ce0d592144..fed861eea2 100644 --- a/TESTING/EIG/sdrgsx.f +++ b/TESTING/EIG/sdrgsx.f @@ -400,7 +400,7 @@ SUBROUTINE SDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, EXTERNAL SLCTSX, ILAENV, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL ALASVM, SGESVD, SGET51, SGET53, SGGESX, SLABAD, + EXTERNAL ALASVM, SGESVD, SGET51, SGET53, SGGESX, $ SLACPY, SLAKF2, SLASET, SLATM5, XERBLA * .. * .. Intrinsic Functions .. @@ -479,7 +479,6 @@ SUBROUTINE SDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, ULPINV = ONE / ULP SMLNUM = SLAMCH( 'S' ) / ULP BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) THRSH2 = TEN*THRESH NTESTT = 0 NERRS = 0 diff --git a/TESTING/EIG/sdrvbd.f b/TESTING/EIG/sdrvbd.f index de6d5a4123..77abb532f4 100644 --- a/TESTING/EIG/sdrvbd.f +++ b/TESTING/EIG/sdrvbd.f @@ -420,8 +420,8 @@ SUBROUTINE SDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, * .. * .. External Subroutines .. EXTERNAL ALASVM, SBDT01, SGEJSV, SGESDD, SGESVD, - $ SGESVDQ, SGESVDX, SGESVJ, SLABAD, SLACPY, - $ SLASET, SLATMS, SORT01, SORT03, XERBLA + $ SGESVDQ, SGESVDX, SGESVJ, SLACPY, SLASET, + $ SLATMS, SORT01, SORT03, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, INT, MAX, MIN @@ -497,7 +497,6 @@ SUBROUTINE SDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, NTEST = 0 UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) RTUNFL = SQRT( UNFL ) ULPINV = ONE / ULP diff --git a/TESTING/EIG/sdrves.f b/TESTING/EIG/sdrves.f index 4e3dc0a6d9..f82939d7fe 100644 --- a/TESTING/EIG/sdrves.f +++ b/TESTING/EIG/sdrves.f @@ -444,8 +444,8 @@ SUBROUTINE SDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SSLECT, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SGEES, SHST01, SLABAD, SLACPY, SLASUM, SLATME, - $ SLATMR, SLATMS, SLASET, XERBLA + EXTERNAL SGEES, SHST01, SLACPY, SLASUM, SLATME, SLATMR, + $ SLATMS, SLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SIGN, SQRT @@ -514,7 +514,6 @@ SUBROUTINE SDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/sdrvev.f b/TESTING/EIG/sdrvev.f index 6d5e34bf6f..f6d233551e 100644 --- a/TESTING/EIG/sdrvev.f +++ b/TESTING/EIG/sdrvev.f @@ -452,7 +452,7 @@ SUBROUTINE SDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH, SLAPY2, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SGEEV, SGET22, SLABAD, SLACPY, SLASUM, SLATME, + EXTERNAL SGEEV, SGET22, SLACPY, SLASUM, SLATME, $ SLATMR, SLATMS, SLASET, XERBLA * .. * .. Intrinsic Functions .. @@ -525,7 +525,6 @@ SUBROUTINE SDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/sdrvsg.f b/TESTING/EIG/sdrvsg.f index 877579bcd0..f670627122 100644 --- a/TESTING/EIG/sdrvsg.f +++ b/TESTING/EIG/sdrvsg.f @@ -399,7 +399,7 @@ SUBROUTINE SDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL LSAME, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLACPY, SLAFTS, SLASET, SLASUM, SLATMR, + EXTERNAL SLACPY, SLAFTS, SLASET, SLASUM, SLATMR, $ SLATMS, SSBGV, SSBGVD, SSBGVX, SSGT01, SSPGV, $ SSPGVD, SSPGVX, SSYGV, SSYGVD, SSYGVX, XERBLA * .. @@ -460,7 +460,6 @@ SUBROUTINE SDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/sdrvsg2stg.f b/TESTING/EIG/sdrvsg2stg.f index ebd1699777..92080c5676 100644 --- a/TESTING/EIG/sdrvsg2stg.f +++ b/TESTING/EIG/sdrvsg2stg.f @@ -408,7 +408,7 @@ SUBROUTINE SDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL LSAME, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLACPY, SLAFTS, SLASET, SLASUM, SLATMR, + EXTERNAL SLACPY, SLAFTS, SLASET, SLASUM, SLATMR, $ SLATMS, SSBGV, SSBGVD, SSBGVX, SSGT01, SSPGV, $ SSPGVD, SSPGVX, SSYGV, SSYGVD, SSYGVX, XERBLA, $ SSYGV_2STAGE @@ -470,7 +470,6 @@ SUBROUTINE SDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/sdrvst.f b/TESTING/EIG/sdrvst.f index ea0cf66f9f..9a3137b25a 100644 --- a/TESTING/EIG/sdrvst.f +++ b/TESTING/EIG/sdrvst.f @@ -502,11 +502,11 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH, SLARND, SSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASVM, SLABAD, SLACPY, SLAFTS, SLASET, SLATMR, - $ SLATMS, SSBEV, SSBEVD, SSBEVX, SSPEV, SSPEVD, - $ SSPEVX, SSTEV, SSTEVD, SSTEVR, SSTEVX, SSTT21, - $ SSTT22, SSYEV, SSYEVD, SSYEVR, SSYEVX, SSYT21, - $ SSYT22, XERBLA + EXTERNAL ALASVM, SLACPY, SLAFTS, SLASET, SLATMR, SLATMS, + $ SSBEV, SSBEVD, SSBEVX, SSPEV, SSPEVD, SSPEVX, + $ SSTEV, SSTEVD, SSTEVR, SSTEVX, SSTT21, SSTT22, + $ SSYEV, SSYEVD, SSYEVR, SSYEVX, SSYT21, SSYT22, + $ XERBLA * .. * .. Scalars in Common .. CHARACTER*32 SRNAMT @@ -574,7 +574,6 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/sdrvst2stg.f b/TESTING/EIG/sdrvst2stg.f index a13a58b486..450b33c45e 100644 --- a/TESTING/EIG/sdrvst2stg.f +++ b/TESTING/EIG/sdrvst2stg.f @@ -502,7 +502,7 @@ SUBROUTINE SDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH, SLARND, SSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASVM, SLABAD, SLACPY, SLAFTS, SLASET, SLATMR, + EXTERNAL ALASVM, SLACPY, SLAFTS, SLASET, SLATMR, $ SLATMS, SSBEV, SSBEVD, SSBEVX, SSPEV, SSPEVD, $ SSPEVX, SSTEV, SSTEVD, SSTEVR, SSTEVX, SSTT21, $ SSTT22, SSYEV, SSYEVD, SSYEVR, SSYEVX, SSYT21, @@ -577,7 +577,6 @@ SUBROUTINE SDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = SLAMCH( 'Overflow' ) - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/sdrvsx.f b/TESTING/EIG/sdrvsx.f index b6f772f5b6..003140483c 100644 --- a/TESTING/EIG/sdrvsx.f +++ b/TESTING/EIG/sdrvsx.f @@ -508,7 +508,7 @@ SUBROUTINE SDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SGET24, SLABAD, SLASUM, SLATME, SLATMR, SLATMS, + EXTERNAL SGET24, SLASUM, SLATME, SLATMR, SLATMS, $ SLASET, XERBLA * .. * .. Intrinsic Functions .. @@ -583,7 +583,6 @@ SUBROUTINE SDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/sdrvvx.f b/TESTING/EIG/sdrvvx.f index 70e59bcea9..035b22d590 100644 --- a/TESTING/EIG/sdrvvx.f +++ b/TESTING/EIG/sdrvvx.f @@ -567,8 +567,8 @@ SUBROUTINE SDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SGET23, SLABAD, SLASUM, SLATME, SLATMR, SLATMS, - $ SLASET, XERBLA + EXTERNAL SGET23, SLASUM, SLATME, SLATMR, SLATMS, SLASET, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -643,7 +643,6 @@ SUBROUTINE SDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = SLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) ULP = SLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/sget31.f b/TESTING/EIG/sget31.f index fd2d980d3b..c5ec3ee419 100644 --- a/TESTING/EIG/sget31.f +++ b/TESTING/EIG/sget31.f @@ -130,7 +130,7 @@ SUBROUTINE SGET31( RMAX, LMAX, NINFO, KNT ) EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLALN2 + EXTERNAL SLALN2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT @@ -146,7 +146,6 @@ SUBROUTINE SGET31( RMAX, LMAX, NINFO, KNT ) UNFL = SLAMCH( 'U' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/sget32.f b/TESTING/EIG/sget32.f index 7a0efd0827..948fb80f27 100644 --- a/TESTING/EIG/sget32.f +++ b/TESTING/EIG/sget32.f @@ -114,7 +114,7 @@ SUBROUTINE SGET32( RMAX, LMAX, NINFO, KNT ) EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLASY2 + EXTERNAL SLASY2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -131,7 +131,6 @@ SUBROUTINE SGET32( RMAX, LMAX, NINFO, KNT ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/sget33.f b/TESTING/EIG/sget33.f index 48cee8d447..a73c423588 100644 --- a/TESTING/EIG/sget33.f +++ b/TESTING/EIG/sget33.f @@ -105,7 +105,7 @@ SUBROUTINE SGET33( RMAX, LMAX, NINFO, KNT ) EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLANV2 + EXTERNAL SLANV2 * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SIGN @@ -117,7 +117,6 @@ SUBROUTINE SGET33( RMAX, LMAX, NINFO, KNT ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/sget34.f b/TESTING/EIG/sget34.f index 27f705ca3c..21ca3756d8 100644 --- a/TESTING/EIG/sget34.f +++ b/TESTING/EIG/sget34.f @@ -128,7 +128,6 @@ SUBROUTINE SGET34( RMAX, LMAX, NINFO, KNT ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/sget35.f b/TESTING/EIG/sget35.f index 46c8b699f9..b91677e8e2 100644 --- a/TESTING/EIG/sget35.f +++ b/TESTING/EIG/sget35.f @@ -133,7 +133,6 @@ SUBROUTINE SGET35( RMAX, LMAX, NINFO, KNT ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' )*FOUR / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/sget37.f b/TESTING/EIG/sget37.f index eb10424bf1..4867e2c255 100644 --- a/TESTING/EIG/sget37.f +++ b/TESTING/EIG/sget37.f @@ -131,8 +131,8 @@ SUBROUTINE SGET37( RMAX, LMAX, NINFO, KNT, NIN ) EXTERNAL SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEHRD, SHSEQR, SLABAD, SLACPY, SSCAL, - $ STREVC, STRSNA + EXTERNAL SCOPY, SGEHRD, SHSEQR, SLACPY, SSCAL, STREVC, + $ STRSNA * .. * .. Intrinsic Functions .. INTRINSIC MAX, REAL, SQRT @@ -142,7 +142,6 @@ SUBROUTINE SGET37( RMAX, LMAX, NINFO, KNT, NIN ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/sget38.f b/TESTING/EIG/sget38.f index 636dfb70ee..6cc56866ec 100644 --- a/TESTING/EIG/sget38.f +++ b/TESTING/EIG/sget38.f @@ -134,8 +134,8 @@ SUBROUTINE SGET38( RMAX, LMAX, NINFO, KNT, NIN ) EXTERNAL SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEHRD, SHSEQR, SHST01, SLABAD, SLACPY, - $ SORGHR, SSCAL, STRSEN + EXTERNAL SCOPY, SGEHRD, SHSEQR, SHST01, SLACPY, SORGHR, + $ SSCAL, STRSEN * .. * .. Intrinsic Functions .. INTRINSIC MAX, REAL, SQRT @@ -145,7 +145,6 @@ SUBROUTINE SGET38( RMAX, LMAX, NINFO, KNT, NIN ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/sget39.f b/TESTING/EIG/sget39.f index dbcabf9d7d..4fee5eb004 100644 --- a/TESTING/EIG/sget39.f +++ b/TESTING/EIG/sget39.f @@ -130,7 +130,7 @@ SUBROUTINE SGET39( RMAX, LMAX, NINFO, KNT ) EXTERNAL ISAMAX, SASUM, SDOT, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SCOPY, SGEMV, SLABAD, SLAQTR + EXTERNAL SCOPY, SGEMV, SLAQTR * .. * .. Intrinsic Functions .. INTRINSIC ABS, COS, MAX, REAL, SIN, SQRT @@ -159,7 +159,6 @@ SUBROUTINE SGET39( RMAX, LMAX, NINFO, KNT ) EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/shst01.f b/TESTING/EIG/shst01.f index 97b14c211a..c18b9ebba5 100644 --- a/TESTING/EIG/shst01.f +++ b/TESTING/EIG/shst01.f @@ -159,7 +159,7 @@ SUBROUTINE SHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, EXTERNAL SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SGEMM, SLABAD, SLACPY, SORT01 + EXTERNAL SGEMM, SLACPY, SORT01 * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -177,7 +177,6 @@ SUBROUTINE SHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, UNFL = SLAMCH( 'Safe minimum' ) EPS = SLAMCH( 'Precision' ) OVFL = ONE / UNFL - CALL SLABAD( UNFL, OVFL ) SMLNUM = UNFL*N / EPS * * Test 1: Compute norm( A - Q*H*Q' ) / ( norm(A) * N * EPS ) diff --git a/TESTING/EIG/slatb9.f b/TESTING/EIG/slatb9.f index f8638a46a0..b68dcda317 100644 --- a/TESTING/EIG/slatb9.f +++ b/TESTING/EIG/slatb9.f @@ -199,9 +199,6 @@ SUBROUTINE SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, * .. Intrinsic Functions .. INTRINSIC MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -219,11 +216,6 @@ SUBROUTINE SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, BADC1 = SQRT( BADC2 ) SMALL = SLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL SLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/EIG/zchkbd.f b/TESTING/EIG/zchkbd.f index 034cf57cfd..3fe2256fae 100644 --- a/TESTING/EIG/zchkbd.f +++ b/TESTING/EIG/zchkbd.f @@ -463,9 +463,9 @@ SUBROUTINE ZCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, EXTERNAL DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL ALASUM, DCOPY, DLABAD, DLAHD2, DSVDCH, XERBLA, - $ ZBDSQR, ZBDT01, ZBDT02, ZBDT03, ZGEBRD, ZGEMM, - $ ZLACPY, ZLASET, ZLATMR, ZLATMS, ZUNGBR, ZUNT01 + EXTERNAL ALASUM, DCOPY, DLAHD2, DSVDCH, XERBLA, ZBDSQR, + $ ZBDT01, ZBDT02, ZBDT03, ZGEBRD, ZGEMM, ZLACPY, + $ ZLASET, ZLATMR, ZLATMS, ZUNGBR, ZUNT01 * .. * .. Intrinsic Functions .. INTRINSIC ABS, EXP, INT, LOG, MAX, MIN, SQRT @@ -547,7 +547,6 @@ SUBROUTINE ZCHKBD( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, NTEST = 0 UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/zchkgg.f b/TESTING/EIG/zchkgg.f index 5e6797f502..239fe752ed 100644 --- a/TESTING/EIG/zchkgg.f +++ b/TESTING/EIG/zchkgg.f @@ -559,9 +559,9 @@ SUBROUTINE ZCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, ZLANGE, ZLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASUM, XERBLA, ZGEQR2, ZGET51, ZGET52, - $ ZGGHRD, ZHGEQZ, ZLACPY, ZLARFG, ZLASET, ZLATM4, - $ ZTGEVC, ZUNM2R + EXTERNAL DLASUM, XERBLA, ZGEQR2, ZGET51, ZGET52, ZGGHRD, + $ ZHGEQZ, ZLACPY, ZLARFG, ZLASET, ZLATM4, ZTGEVC, + $ ZUNM2R * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, MAX, MIN, SIGN @@ -639,7 +639,6 @@ SUBROUTINE ZCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/zchkhs.f b/TESTING/EIG/zchkhs.f index f5ae9b7f3c..b08a8ea583 100644 --- a/TESTING/EIG/zchkhs.f +++ b/TESTING/EIG/zchkhs.f @@ -470,10 +470,10 @@ SUBROUTINE ZCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLAFTS, DLASUM, XERBLA, ZCOPY, ZGEHRD, - $ ZGEMM, ZGET10, ZGET22, ZHSEIN, ZHSEQR, ZHST01, - $ ZLACPY, ZLASET, ZLATME, ZLATMR, ZLATMS, ZTREVC, - $ ZTREVC3, ZUNGHR, ZUNMHR + EXTERNAL DLAFTS, DLASUM, XERBLA, ZCOPY, ZGEHRD, ZGEMM, + $ ZGET10, ZGET22, ZHSEIN, ZHSEQR, ZHST01, ZLACPY, + $ ZLASET, ZLATME, ZLATMR, ZLATMS, ZTREVC, ZTREVC3, + $ ZUNGHR, ZUNMHR * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SQRT @@ -533,7 +533,6 @@ SUBROUTINE ZCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/zchkst.f b/TESTING/EIG/zchkst.f index 60496dde1b..9fdff96944 100644 --- a/TESTING/EIG/zchkst.f +++ b/TESTING/EIG/zchkst.f @@ -662,11 +662,10 @@ SUBROUTINE ZCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DLASUM, DSTEBZ, DSTECH, DSTERF, - $ XERBLA, ZCOPY, ZHET21, ZHETRD, ZHPT21, ZHPTRD, - $ ZLACPY, ZLASET, ZLATMR, ZLATMS, ZPTEQR, ZSTEDC, - $ ZSTEMR, ZSTEIN, ZSTEQR, ZSTT21, ZSTT22, ZUNGTR, - $ ZUPGTR + EXTERNAL DCOPY, DLASUM, DSTEBZ, DSTECH, DSTERF, XERBLA, + $ ZCOPY, ZHET21, ZHETRD, ZHPT21, ZHPTRD, ZLACPY, + $ ZLASET, ZLATMR, ZLATMS, ZPTEQR, ZSTEDC, ZSTEMR, + $ ZSTEIN, ZSTEQR, ZSTT21, ZSTT22, ZUNGTR, ZUPGTR * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, INT, LOG, MAX, MIN, SQRT @@ -733,7 +732,6 @@ SUBROUTINE ZCHKST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/zchkst2stg.f b/TESTING/EIG/zchkst2stg.f index b1ef808166..fb25b738da 100644 --- a/TESTING/EIG/zchkst2stg.f +++ b/TESTING/EIG/zchkst2stg.f @@ -683,11 +683,11 @@ SUBROUTINE ZCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DLASUM, DSTEBZ, DSTECH, DSTERF, - $ XERBLA, ZCOPY, ZHET21, ZHETRD, ZHPT21, ZHPTRD, - $ ZLACPY, ZLASET, ZLATMR, ZLATMS, ZPTEQR, ZSTEDC, - $ ZSTEMR, ZSTEIN, ZSTEQR, ZSTT21, ZSTT22, ZUNGTR, - $ ZUPGTR, ZHETRD_2STAGE, DLASET + EXTERNAL DCOPY, DLASUM, DSTEBZ, DSTECH, DSTERF, XERBLA, + $ ZCOPY, ZHET21, ZHETRD, ZHPT21, ZHPTRD, ZLACPY, + $ ZLASET, ZLATMR, ZLATMS, ZPTEQR, ZSTEDC, ZSTEMR, + $ ZSTEIN, ZSTEQR, ZSTT21, ZSTT22, ZUNGTR, ZUPGTR, + $ ZHETRD_2STAGE, DLASET * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, INT, LOG, MAX, MIN, SQRT @@ -754,7 +754,6 @@ SUBROUTINE ZCHKST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP LOG2UI = INT( LOG( ULPINV ) / LOG( TWO ) ) diff --git a/TESTING/EIG/zdrges.f b/TESTING/EIG/zdrges.f index 580573814f..f677cc85b0 100644 --- a/TESTING/EIG/zdrges.f +++ b/TESTING/EIG/zdrges.f @@ -434,8 +434,8 @@ SUBROUTINE ZDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ZLCTES, ILAENV, DLAMCH, ZLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, XERBLA, ZGET51, ZGET54, ZGGES, - $ ZLACPY, ZLARFG, ZLASET, ZLATM4, ZUNM2R + EXTERNAL ALASVM, XERBLA, ZGET51, ZGET54, ZGGES, ZLACPY, + $ ZLARFG, ZLASET, ZLATM4, ZUNM2R * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SIGN @@ -533,7 +533,6 @@ SUBROUTINE ZDRGES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = DLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/zdrges3.f b/TESTING/EIG/zdrges3.f index b678e47042..f3d8869590 100644 --- a/TESTING/EIG/zdrges3.f +++ b/TESTING/EIG/zdrges3.f @@ -435,8 +435,8 @@ SUBROUTINE ZDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ZLCTES, ILAENV, DLAMCH, ZLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, XERBLA, ZGET51, ZGET54, ZGGES3, - $ ZLACPY, ZLARFG, ZLASET, ZLATM4, ZUNM2R + EXTERNAL ALASVM, XERBLA, ZGET51, ZGET54, ZGGES3, ZLACPY, + $ ZLARFG, ZLASET, ZLATM4, ZUNM2R * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SIGN @@ -534,7 +534,6 @@ SUBROUTINE ZDRGES3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = DLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/zdrgev.f b/TESTING/EIG/zdrgev.f index e7389183bc..7adf9ba8f3 100644 --- a/TESTING/EIG/zdrgev.f +++ b/TESTING/EIG/zdrgev.f @@ -451,7 +451,7 @@ SUBROUTINE ZDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, ZLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, XERBLA, ZGET52, ZGGEV, ZLACPY, + EXTERNAL ALASVM, XERBLA, ZGET52, ZGGEV, ZLACPY, $ ZLARFG, ZLASET, ZLATM4, ZUNM2R * .. * .. Intrinsic Functions .. @@ -546,7 +546,6 @@ SUBROUTINE ZDRGEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = DLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/zdrgev3.f b/TESTING/EIG/zdrgev3.f index 4ccc987763..f445913198 100644 --- a/TESTING/EIG/zdrgev3.f +++ b/TESTING/EIG/zdrgev3.f @@ -451,8 +451,8 @@ SUBROUTINE ZDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ILAENV, DLAMCH, ZLARND * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, XERBLA, ZGET52, ZGGEV3, ZLACPY, - $ ZLARFG, ZLASET, ZLATM4, ZUNM2R + EXTERNAL ALASVM, XERBLA, ZGET52, ZGGEV3, ZLACPY, ZLARFG, + $ ZLASET, ZLATM4, ZUNM2R * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCONJG, MAX, MIN, SIGN @@ -546,7 +546,6 @@ SUBROUTINE ZDRGEV3( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, SAFMIN = DLAMCH( 'Safe minimum' ) SAFMIN = SAFMIN / ULP SAFMAX = ONE / SAFMIN - CALL DLABAD( SAFMIN, SAFMAX ) ULPINV = ONE / ULP * * The values RMAGN(2:3) depend on N, see below. diff --git a/TESTING/EIG/zdrgsx.f b/TESTING/EIG/zdrgsx.f index 096ed3c225..085b9b9ad6 100644 --- a/TESTING/EIG/zdrgsx.f +++ b/TESTING/EIG/zdrgsx.f @@ -394,7 +394,7 @@ SUBROUTINE ZDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, AI, EXTERNAL ZLCTSX, ILAENV, DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, XERBLA, ZGESVD, ZGET51, ZGGESX, + EXTERNAL ALASVM, XERBLA, ZGESVD, ZGET51, ZGGESX, $ ZLACPY, ZLAKF2, ZLASET, ZLATM5 * .. * .. Scalars in Common .. @@ -479,7 +479,6 @@ SUBROUTINE ZDRGSX( NSIZE, NCMAX, THRESH, NIN, NOUT, A, LDA, B, AI, ULPINV = ONE / ULP SMLNUM = DLAMCH( 'S' ) / ULP BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) THRSH2 = TEN*THRESH NTESTT = 0 NERRS = 0 diff --git a/TESTING/EIG/zdrves.f b/TESTING/EIG/zdrves.f index d3f237c23b..1d81e7f336 100644 --- a/TESTING/EIG/zdrves.f +++ b/TESTING/EIG/zdrves.f @@ -437,8 +437,8 @@ SUBROUTINE ZDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL ZSLECT, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASUM, XERBLA, ZGEES, ZHST01, ZLACPY, - $ ZLASET, ZLATME, ZLATMR, ZLATMS + EXTERNAL DLASUM, XERBLA, ZGEES, ZHST01, ZLACPY, ZLASET, + $ ZLATME, ZLATMR, ZLATMS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DCMPLX, MAX, MIN, SQRT @@ -507,7 +507,6 @@ SUBROUTINE ZDRVES( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/zdrvev.f b/TESTING/EIG/zdrvev.f index 4fbb10e100..ca410f437f 100644 --- a/TESTING/EIG/zdrvev.f +++ b/TESTING/EIG/zdrvev.f @@ -442,7 +442,7 @@ SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, DZNRM2 * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASUM, XERBLA, ZGEEV, ZGET22, ZLACPY, + EXTERNAL DLASUM, XERBLA, ZGEEV, ZGET22, ZLACPY, $ ZLASET, ZLATME, ZLATMR, ZLATMS * .. * .. Intrinsic Functions .. @@ -515,7 +515,6 @@ SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/zdrvsg.f b/TESTING/EIG/zdrvsg.f index 71f1d6371b..fa92f6fd5d 100644 --- a/TESTING/EIG/zdrvsg.f +++ b/TESTING/EIG/zdrvsg.f @@ -418,7 +418,7 @@ SUBROUTINE ZDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL LSAME, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD, + EXTERNAL DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD, $ ZHBGVX, ZHEGV, ZHEGVD, ZHEGVX, ZHPGV, ZHPGVD, $ ZHPGVX, ZLACPY, ZLASET, ZLATMR, ZLATMS, ZSGT01 * .. @@ -481,7 +481,6 @@ SUBROUTINE ZDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/zdrvsg2stg.f b/TESTING/EIG/zdrvsg2stg.f index 4bdf2849ed..ebe42bfa9b 100644 --- a/TESTING/EIG/zdrvsg2stg.f +++ b/TESTING/EIG/zdrvsg2stg.f @@ -426,7 +426,7 @@ SUBROUTINE ZDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL LSAME, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD, + EXTERNAL DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD, $ ZHBGVX, ZHEGV, ZHEGVD, ZHEGVX, ZHPGV, ZHPGVD, $ ZHPGVX, ZLACPY, ZLASET, ZLATMR, ZLATMS, ZSGT01, $ ZHEGV_2STAGE @@ -490,7 +490,6 @@ SUBROUTINE ZDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/zdrvst.f b/TESTING/EIG/zdrvst.f index 384e58de16..5ec5c52290 100644 --- a/TESTING/EIG/zdrvst.f +++ b/TESTING/EIG/zdrvst.f @@ -391,10 +391,10 @@ SUBROUTINE ZDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, DLAFTS, XERBLA, ZHBEV, ZHBEVD, - $ ZHBEVX, ZHEEV, ZHEEVD, ZHEEVR, ZHEEVX, ZHET21, - $ ZHET22, ZHPEV, ZHPEVD, ZHPEVX, ZLACPY, ZLASET, - $ ZLATMR, ZLATMS + EXTERNAL ALASVM, DLAFTS, XERBLA, ZHBEV, ZHBEVD, ZHBEVX, + $ ZHEEV, ZHEEVD, ZHEEVR, ZHEEVX, ZHET21, ZHET22, + $ ZHPEV, ZHPEVD, ZHPEVX, ZLACPY, ZLASET, ZLATMR, + $ ZLATMS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN, SQRT @@ -451,7 +451,6 @@ SUBROUTINE ZDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/zdrvst2stg.f b/TESTING/EIG/zdrvst2stg.f index 4a88e5218d..f02186f2a9 100644 --- a/TESTING/EIG/zdrvst2stg.f +++ b/TESTING/EIG/zdrvst2stg.f @@ -391,7 +391,7 @@ SUBROUTINE ZDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH, DLARND, DSXT1 * .. * .. External Subroutines .. - EXTERNAL ALASVM, DLABAD, DLAFTS, XERBLA, ZHBEV, ZHBEVD, + EXTERNAL ALASVM, DLAFTS, XERBLA, ZHBEV, ZHBEVD, $ ZHBEVX, ZHEEV, ZHEEVD, ZHEEVR, ZHEEVX, ZHET21, $ ZHET22, ZHPEV, ZHPEVD, ZHPEVX, ZLACPY, ZLASET, $ ZHEEVD_2STAGE, ZHEEVR_2STAGE, ZHEEVX_2STAGE, @@ -453,7 +453,6 @@ SUBROUTINE ZDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = DLAMCH( 'Overflow' ) - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) ULPINV = ONE / ULP RTUNFL = SQRT( UNFL ) diff --git a/TESTING/EIG/zdrvsx.f b/TESTING/EIG/zdrvsx.f index ac7a2d6ebc..03de455393 100644 --- a/TESTING/EIG/zdrvsx.f +++ b/TESTING/EIG/zdrvsx.f @@ -492,7 +492,7 @@ SUBROUTINE ZDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASUM, XERBLA, ZGET24, ZLASET, ZLATME, + EXTERNAL DLASUM, XERBLA, ZGET24, ZLASET, ZLATME, $ ZLATMR, ZLATMS * .. * .. Intrinsic Functions .. @@ -567,7 +567,6 @@ SUBROUTINE ZDRVSX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/zdrvvx.f b/TESTING/EIG/zdrvvx.f index 830313c726..f5dfa982a7 100644 --- a/TESTING/EIG/zdrvvx.f +++ b/TESTING/EIG/zdrvvx.f @@ -548,8 +548,8 @@ SUBROUTINE ZDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLASUM, XERBLA, ZGET23, ZLASET, ZLATME, - $ ZLATMR, ZLATMS + EXTERNAL DLASUM, XERBLA, ZGET23, ZLASET, ZLATME, ZLATMR, + $ ZLATMS * .. * .. Intrinsic Functions .. INTRINSIC ABS, DCMPLX, MAX, MIN, SQRT @@ -624,7 +624,6 @@ SUBROUTINE ZDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * UNFL = DLAMCH( 'Safe minimum' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) ULP = DLAMCH( 'Precision' ) ULPINV = ONE / ULP RTULP = SQRT( ULP ) diff --git a/TESTING/EIG/zget35.f b/TESTING/EIG/zget35.f index 5da48bcb0f..1fb27892d9 100644 --- a/TESTING/EIG/zget35.f +++ b/TESTING/EIG/zget35.f @@ -122,7 +122,7 @@ SUBROUTINE ZGET35( RMAX, LMAX, NINFO, KNT, NIN ) EXTERNAL DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZGEMM, ZTRSYL + EXTERNAL ZGEMM, ZTRSYL * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, SQRT @@ -134,7 +134,6 @@ SUBROUTINE ZGET35( RMAX, LMAX, NINFO, KNT, NIN ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Set up test case parameters * diff --git a/TESTING/EIG/zget37.f b/TESTING/EIG/zget37.f index 5013fbdd9f..065280ae56 100644 --- a/TESTING/EIG/zget37.f +++ b/TESTING/EIG/zget37.f @@ -131,8 +131,8 @@ SUBROUTINE ZGET37( RMAX, LMAX, NINFO, KNT, NIN ) EXTERNAL DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DSCAL, ZCOPY, ZDSCAL, ZGEHRD, - $ ZHSEQR, ZLACPY, ZTREVC, ZTRSNA + EXTERNAL DCOPY, DSCAL, ZCOPY, ZDSCAL, ZGEHRD, ZHSEQR, + $ ZLACPY, ZTREVC, ZTRSNA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DIMAG, MAX, SQRT @@ -142,7 +142,6 @@ SUBROUTINE ZGET37( RMAX, LMAX, NINFO, KNT, NIN ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/zget38.f b/TESTING/EIG/zget38.f index 43b538fcf2..337569c032 100644 --- a/TESTING/EIG/zget38.f +++ b/TESTING/EIG/zget38.f @@ -135,8 +135,8 @@ SUBROUTINE ZGET38( RMAX, LMAX, NINFO, KNT, NIN ) EXTERNAL DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZDSCAL, ZGEHRD, ZHSEQR, ZHST01, ZLACPY, - $ ZTRSEN, ZUNGHR + EXTERNAL ZDSCAL, ZGEHRD, ZHSEQR, ZHST01, ZLACPY, ZTRSEN, + $ ZUNGHR * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DIMAG, MAX, SQRT @@ -146,7 +146,6 @@ SUBROUTINE ZGET38( RMAX, LMAX, NINFO, KNT, NIN ) EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * EPSIN = 2**(-24) = precision to which input data computed * diff --git a/TESTING/EIG/zhst01.f b/TESTING/EIG/zhst01.f index ebb1c48952..b6dc27c32e 100644 --- a/TESTING/EIG/zhst01.f +++ b/TESTING/EIG/zhst01.f @@ -166,7 +166,7 @@ SUBROUTINE ZHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, EXTERNAL DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZGEMM, ZLACPY, ZUNT01 + EXTERNAL ZGEMM, ZLACPY, ZUNT01 * .. * .. Intrinsic Functions .. INTRINSIC DCMPLX, MAX, MIN @@ -184,7 +184,6 @@ SUBROUTINE ZHST01( N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, UNFL = DLAMCH( 'Safe minimum' ) EPS = DLAMCH( 'Precision' ) OVFL = ONE / UNFL - CALL DLABAD( UNFL, OVFL ) SMLNUM = UNFL*N / EPS * * Test 1: Compute norm( A - Q*H*Q' ) / ( norm(A) * N * EPS ) diff --git a/TESTING/LIN/clatb4.f b/TESTING/LIN/clatb4.f index 4fc7f1ba21..e04ba3dfe1 100644 --- a/TESTING/LIN/clatb4.f +++ b/TESTING/LIN/clatb4.f @@ -154,9 +154,6 @@ SUBROUTINE CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -174,11 +171,6 @@ SUBROUTINE CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = SLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL SLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/clatb5.f b/TESTING/LIN/clatb5.f index 16f27656e4..91e3a6a1b3 100644 --- a/TESTING/LIN/clatb5.f +++ b/TESTING/LIN/clatb5.f @@ -145,9 +145,6 @@ SUBROUTINE CLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -165,11 +162,6 @@ SUBROUTINE CLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = SLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL SLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/clattb.f b/TESTING/LIN/clattb.f index c5a21f51f9..cc836b49ba 100644 --- a/TESTING/LIN/clattb.f +++ b/TESTING/LIN/clattb.f @@ -178,7 +178,7 @@ SUBROUTINE CLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, * .. * .. External Subroutines .. EXTERNAL CCOPY, CLARNV, CLATB4, CLATMS, CSSCAL, CSWAP, - $ SLABAD, SLARNV + $ SLARNV * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, MAX, MIN, REAL, SQRT @@ -191,7 +191,6 @@ SUBROUTINE CLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/clattp.f b/TESTING/LIN/clattp.f index a47a252ada..970d523934 100644 --- a/TESTING/LIN/clattp.f +++ b/TESTING/LIN/clattp.f @@ -169,7 +169,7 @@ SUBROUTINE CLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, * .. * .. External Subroutines .. EXTERNAL CLARNV, CLATB4, CLATMS, CROT, CROTG, CSSCAL, - $ SLABAD, SLARNV + $ SLARNV * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, CONJG, MAX, REAL, SQRT @@ -182,7 +182,6 @@ SUBROUTINE CLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/clattr.f b/TESTING/LIN/clattr.f index c26e2f9026..a53e7cd933 100644 --- a/TESTING/LIN/clattr.f +++ b/TESTING/LIN/clattr.f @@ -175,7 +175,7 @@ SUBROUTINE CLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, * .. * .. External Subroutines .. EXTERNAL CCOPY, CLARNV, CLATB4, CLATMS, CROT, CROTG, - $ CSSCAL, CSWAP, SLABAD, SLARNV + $ CSSCAL, CSWAP, SLARNV * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, CONJG, MAX, REAL, SQRT @@ -188,7 +188,6 @@ SUBROUTINE CLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/cqrt12.f b/TESTING/LIN/cqrt12.f index 4c29423ae5..80ff6dbdf9 100644 --- a/TESTING/LIN/cqrt12.f +++ b/TESTING/LIN/cqrt12.f @@ -125,8 +125,8 @@ REAL FUNCTION CQRT12( M, N, A, LDA, S, WORK, LWORK, EXTERNAL CLANGE, SASUM, SLAMCH, SNRM2 * .. * .. External Subroutines .. - EXTERNAL CGEBD2, CLASCL, CLASET, SAXPY, SBDSQR, SLABAD, - $ SLASCL, XERBLA + EXTERNAL CGEBD2, CLASCL, CLASET, SAXPY, SBDSQR, SLASCL, + $ XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CMPLX, MAX, MIN, REAL @@ -163,7 +163,6 @@ REAL FUNCTION CQRT12( M, N, A, LDA, S, WORK, LWORK, * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale work if max entry outside range [SMLNUM,BIGNUM] * diff --git a/TESTING/LIN/cqrt13.f b/TESTING/LIN/cqrt13.f index 6b2f42aaba..1aa586fcea 100644 --- a/TESTING/LIN/cqrt13.f +++ b/TESTING/LIN/cqrt13.f @@ -117,7 +117,7 @@ SUBROUTINE CQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) EXTERNAL CLANGE, SCASUM, SLAMCH * .. * .. External Subroutines .. - EXTERNAL CLARNV, CLASCL, SLABAD + EXTERNAL CLARNV, CLASCL * .. * .. Intrinsic Functions .. INTRINSIC CMPLX, REAL, SIGN @@ -146,7 +146,6 @@ SUBROUTINE CQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) NORMA = CLANGE( 'Max', M, N, A, LDA, DUMMY ) SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM / SLAMCH( 'Epsilon' ) BIGNUM = ONE / SMLNUM * diff --git a/TESTING/LIN/cqrt15.f b/TESTING/LIN/cqrt15.f index f766bb4df5..7dfe1324d1 100644 --- a/TESTING/LIN/cqrt15.f +++ b/TESTING/LIN/cqrt15.f @@ -184,7 +184,7 @@ SUBROUTINE CQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, * .. * .. External Subroutines .. EXTERNAL CGEMM, CLARF, CLARNV, CLAROR, CLASCL, CLASET, - $ CSSCAL, SLABAD, SLAORD, SLASCL, XERBLA + $ CSSCAL, SLAORD, SLASCL, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, CMPLX, MAX, MIN @@ -199,7 +199,6 @@ SUBROUTINE CQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, * SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) EPS = SLAMCH( 'Epsilon' ) SMLNUM = ( SMLNUM / EPS ) / EPS BIGNUM = ONE / SMLNUM diff --git a/TESTING/LIN/dlatb4.f b/TESTING/LIN/dlatb4.f index 791f44de2e..28689877c7 100644 --- a/TESTING/LIN/dlatb4.f +++ b/TESTING/LIN/dlatb4.f @@ -153,9 +153,6 @@ SUBROUTINE DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -173,11 +170,6 @@ SUBROUTINE DLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = DLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL DLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/dlatb5.f b/TESTING/LIN/dlatb5.f index 9967bbad1b..6a8aa0fb88 100644 --- a/TESTING/LIN/dlatb5.f +++ b/TESTING/LIN/dlatb5.f @@ -145,9 +145,6 @@ SUBROUTINE DLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -165,11 +162,6 @@ SUBROUTINE DLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = DLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL DLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/dlattb.f b/TESTING/LIN/dlattb.f index e0289249e8..7b854768b0 100644 --- a/TESTING/LIN/dlattb.f +++ b/TESTING/LIN/dlattb.f @@ -168,8 +168,7 @@ SUBROUTINE DLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, EXTERNAL LSAME, IDAMAX, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DLARNV, DLATB4, DLATMS, DSCAL, - $ DSWAP + EXTERNAL DCOPY, DLARNV, DLATB4, DLATMS, DSCAL, DSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SIGN, SQRT @@ -182,7 +181,6 @@ SUBROUTINE DLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/dlattp.f b/TESTING/LIN/dlattp.f index 9c537d486a..3aa51dc159 100644 --- a/TESTING/LIN/dlattp.f +++ b/TESTING/LIN/dlattp.f @@ -160,8 +160,7 @@ SUBROUTINE DLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK, EXTERNAL LSAME, IDAMAX, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLARNV, DLATB4, DLATMS, DROT, DROTG, - $ DSCAL + EXTERNAL DLARNV, DLATB4, DLATMS, DROT, DROTG, DSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, SIGN, SQRT @@ -174,7 +173,6 @@ SUBROUTINE DLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/dlattr.f b/TESTING/LIN/dlattr.f index 3cb74bbcca..de9dbbf833 100644 --- a/TESTING/LIN/dlattr.f +++ b/TESTING/LIN/dlattr.f @@ -166,7 +166,7 @@ SUBROUTINE DLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, EXTERNAL LSAME, IDAMAX, DLAMCH, DLARND * .. * .. External Subroutines .. - EXTERNAL DCOPY, DLABAD, DLARNV, DLATB4, DLATMS, DROT, + EXTERNAL DCOPY, DLARNV, DLATB4, DLATMS, DROT, $ DROTG, DSCAL, DSWAP * .. * .. Intrinsic Functions .. @@ -180,7 +180,6 @@ SUBROUTINE DLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/dqrt12.f b/TESTING/LIN/dqrt12.f index 278e01bf0a..a3bfbebb3d 100644 --- a/TESTING/LIN/dqrt12.f +++ b/TESTING/LIN/dqrt12.f @@ -113,8 +113,7 @@ DOUBLE PRECISION FUNCTION DQRT12( M, N, A, LDA, S, WORK, LWORK ) EXTERNAL DASUM, DLAMCH, DLANGE, DNRM2 * .. * .. External Subroutines .. - EXTERNAL DAXPY, DBDSQR, DGEBD2, DLABAD, DLASCL, DLASET, - $ XERBLA + EXTERNAL DAXPY, DBDSQR, DGEBD2, DLASCL, DLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC DBLE, MAX, MIN @@ -155,7 +154,6 @@ DOUBLE PRECISION FUNCTION DQRT12( M, N, A, LDA, S, WORK, LWORK ) * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale work if max entry outside range [SMLNUM,BIGNUM] * diff --git a/TESTING/LIN/dqrt13.f b/TESTING/LIN/dqrt13.f index 203f62069b..359e76a9df 100644 --- a/TESTING/LIN/dqrt13.f +++ b/TESTING/LIN/dqrt13.f @@ -117,7 +117,7 @@ SUBROUTINE DQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) EXTERNAL DASUM, DLAMCH, DLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLARNV, DLASCL + EXTERNAL DLARNV, DLASCL * .. * .. Intrinsic Functions .. INTRINSIC SIGN @@ -146,7 +146,6 @@ SUBROUTINE DQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) NORMA = DLANGE( 'Max', M, N, A, LDA, DUMMY ) SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM / DLAMCH( 'Epsilon' ) BIGNUM = ONE / SMLNUM * diff --git a/TESTING/LIN/dtbt03.f b/TESTING/LIN/dtbt03.f index 04307fd3bb..f3a20e9272 100644 --- a/TESTING/LIN/dtbt03.f +++ b/TESTING/LIN/dtbt03.f @@ -204,7 +204,7 @@ SUBROUTINE DTBT03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, EXTERNAL LSAME, IDAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLABAD, DSCAL, DTBMV + EXTERNAL DAXPY, DCOPY, DSCAL, DTBMV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX @@ -220,7 +220,6 @@ SUBROUTINE DTBT03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, EPS = DLAMCH( 'Epsilon' ) SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Compute the norm of the triangular matrix A using the column * norms already computed by DLATBS. diff --git a/TESTING/LIN/dtbt06.f b/TESTING/LIN/dtbt06.f index 2e87bdaa7a..a731a3f290 100644 --- a/TESTING/LIN/dtbt06.f +++ b/TESTING/LIN/dtbt06.f @@ -152,9 +152,6 @@ SUBROUTINE DTBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Executable Statements .. * EPS = DLAMCH( 'Epsilon' ) @@ -191,7 +188,6 @@ SUBROUTINE DTBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, * SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) ANORM = DLANTB( 'M', UPLO, DIAG, N, KD, AB, LDAB, WORK ) * RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) diff --git a/TESTING/LIN/dtpt03.f b/TESTING/LIN/dtpt03.f index 069836a0c5..267f8b3e02 100644 --- a/TESTING/LIN/dtpt03.f +++ b/TESTING/LIN/dtpt03.f @@ -190,7 +190,7 @@ SUBROUTINE DTPT03( UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, EXTERNAL LSAME, IDAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLABAD, DSCAL, DTPMV + EXTERNAL DAXPY, DCOPY, DSCAL, DTPMV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX @@ -206,7 +206,6 @@ SUBROUTINE DTPT03( UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, EPS = DLAMCH( 'Epsilon' ) SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Compute the norm of the triangular matrix A using the column * norms already computed by DLATPS. diff --git a/TESTING/LIN/dtpt06.f b/TESTING/LIN/dtpt06.f index f5eb2a5126..d38a1e2cbf 100644 --- a/TESTING/LIN/dtpt06.f +++ b/TESTING/LIN/dtpt06.f @@ -138,9 +138,6 @@ SUBROUTINE DTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, WORK, RAT ) * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Executable Statements .. * EPS = DLAMCH( 'Epsilon' ) @@ -177,7 +174,6 @@ SUBROUTINE DTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, WORK, RAT ) * SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) ANORM = DLANTP( 'M', UPLO, DIAG, N, AP, WORK ) * RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) diff --git a/TESTING/LIN/dtrt03.f b/TESTING/LIN/dtrt03.f index ef6a33f6a5..07d0d53d51 100644 --- a/TESTING/LIN/dtrt03.f +++ b/TESTING/LIN/dtrt03.f @@ -198,7 +198,7 @@ SUBROUTINE DTRT03( UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, EXTERNAL LSAME, IDAMAX, DLAMCH * .. * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DLABAD, DSCAL, DTRMV + EXTERNAL DAXPY, DCOPY, DSCAL, DTRMV * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX @@ -214,7 +214,6 @@ SUBROUTINE DTRT03( UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, EPS = DLAMCH( 'Epsilon' ) SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Compute the norm of the triangular matrix A using the column * norms already computed by DLATRS. diff --git a/TESTING/LIN/dtrt06.f b/TESTING/LIN/dtrt06.f index 276e5485fc..d178352027 100644 --- a/TESTING/LIN/dtrt06.f +++ b/TESTING/LIN/dtrt06.f @@ -148,9 +148,6 @@ SUBROUTINE DTRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Executable Statements .. * EPS = DLAMCH( 'Epsilon' ) @@ -187,7 +184,6 @@ SUBROUTINE DTRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, * SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) ANORM = DLANTR( 'M', UPLO, DIAG, N, N, A, LDA, WORK ) * RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) diff --git a/TESTING/LIN/slatb4.f b/TESTING/LIN/slatb4.f index a1df964272..6bf236aaac 100644 --- a/TESTING/LIN/slatb4.f +++ b/TESTING/LIN/slatb4.f @@ -153,9 +153,6 @@ SUBROUTINE SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -173,11 +170,6 @@ SUBROUTINE SLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = SLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL SLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/slatb5.f b/TESTING/LIN/slatb5.f index 6eefee4267..6909110c12 100644 --- a/TESTING/LIN/slatb5.f +++ b/TESTING/LIN/slatb5.f @@ -145,9 +145,6 @@ SUBROUTINE SLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -165,11 +162,6 @@ SUBROUTINE SLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = SLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL SLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/slattb.f b/TESTING/LIN/slattb.f index 57e32b2db8..23a12eadaa 100644 --- a/TESTING/LIN/slattb.f +++ b/TESTING/LIN/slattb.f @@ -168,8 +168,7 @@ SUBROUTINE SLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, EXTERNAL LSAME, ISAMAX, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLABAD, SLARNV, SLATB4, SLATMS, SSCAL, - $ SSWAP + EXTERNAL SCOPY, SLARNV, SLATB4, SLATMS, SSCAL, SSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SIGN, SQRT @@ -182,7 +181,6 @@ SUBROUTINE SLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/slattp.f b/TESTING/LIN/slattp.f index 24650bcc47..8bd133d55a 100644 --- a/TESTING/LIN/slattp.f +++ b/TESTING/LIN/slattp.f @@ -160,8 +160,7 @@ SUBROUTINE SLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK, EXTERNAL LSAME, ISAMAX, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLARNV, SLATB4, SLATMS, SROT, SROTG, - $ SSCAL + EXTERNAL SLARNV, SLATB4, SLATMS, SROT, SROTG, SSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, REAL, SIGN, SQRT @@ -174,7 +173,6 @@ SUBROUTINE SLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/slattr.f b/TESTING/LIN/slattr.f index e1ffd99918..ebc7a6dd9e 100644 --- a/TESTING/LIN/slattr.f +++ b/TESTING/LIN/slattr.f @@ -166,7 +166,7 @@ SUBROUTINE SLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, EXTERNAL LSAME, ISAMAX, SLAMCH, SLARND * .. * .. External Subroutines .. - EXTERNAL SCOPY, SLABAD, SLARNV, SLATB4, SLATMS, SROT, + EXTERNAL SCOPY, SLARNV, SLATB4, SLATMS, SROT, $ SROTG, SSCAL, SSWAP * .. * .. Intrinsic Functions .. @@ -180,7 +180,6 @@ SUBROUTINE SLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/sqrt12.f b/TESTING/LIN/sqrt12.f index 2eab0ee0d6..23fc94c63d 100644 --- a/TESTING/LIN/sqrt12.f +++ b/TESTING/LIN/sqrt12.f @@ -113,8 +113,7 @@ REAL FUNCTION SQRT12( M, N, A, LDA, S, WORK, LWORK ) EXTERNAL SASUM, SLAMCH, SLANGE, SNRM2 * .. * .. External Subroutines .. - EXTERNAL SAXPY, SBDSQR, SGEBD2, SLABAD, SLASCL, SLASET, - $ XERBLA + EXTERNAL SAXPY, SBDSQR, SGEBD2, SLASCL, SLASET, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN, REAL @@ -155,7 +154,6 @@ REAL FUNCTION SQRT12( M, N, A, LDA, S, WORK, LWORK ) * SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Scale work if max entry outside range [SMLNUM,BIGNUM] * diff --git a/TESTING/LIN/sqrt13.f b/TESTING/LIN/sqrt13.f index d77c5fa066..a3828140d6 100644 --- a/TESTING/LIN/sqrt13.f +++ b/TESTING/LIN/sqrt13.f @@ -117,7 +117,7 @@ SUBROUTINE SQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) EXTERNAL SASUM, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SLABAD, SLARNV, SLASCL + EXTERNAL SLARNV, SLASCL * .. * .. Intrinsic Functions .. INTRINSIC SIGN @@ -146,7 +146,6 @@ SUBROUTINE SQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) NORMA = SLANGE( 'Max', M, N, A, LDA, DUMMY ) SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM / SLAMCH( 'Epsilon' ) BIGNUM = ONE / SMLNUM * diff --git a/TESTING/LIN/stbt03.f b/TESTING/LIN/stbt03.f index 3ae44926d3..53efe4030d 100644 --- a/TESTING/LIN/stbt03.f +++ b/TESTING/LIN/stbt03.f @@ -204,7 +204,7 @@ SUBROUTINE STBT03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, EXTERNAL LSAME, ISAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLABAD, SSCAL, STBMV + EXTERNAL SAXPY, SCOPY, SSCAL, STBMV * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, REAL @@ -220,7 +220,6 @@ SUBROUTINE STBT03( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, EPS = SLAMCH( 'Epsilon' ) SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Compute the norm of the triangular matrix A using the column * norms already computed by SLATBS. diff --git a/TESTING/LIN/stbt06.f b/TESTING/LIN/stbt06.f index 8cd5fbc189..d6d0806b44 100644 --- a/TESTING/LIN/stbt06.f +++ b/TESTING/LIN/stbt06.f @@ -152,9 +152,6 @@ SUBROUTINE STBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Executable Statements .. * EPS = SLAMCH( 'Epsilon' ) @@ -191,7 +188,6 @@ SUBROUTINE STBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, * SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) ANORM = SLANTB( 'M', UPLO, DIAG, N, KD, AB, LDAB, WORK ) * RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) diff --git a/TESTING/LIN/stpt03.f b/TESTING/LIN/stpt03.f index 9e844e7978..1235020f97 100644 --- a/TESTING/LIN/stpt03.f +++ b/TESTING/LIN/stpt03.f @@ -190,7 +190,7 @@ SUBROUTINE STPT03( UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, EXTERNAL LSAME, ISAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLABAD, SSCAL, STPMV + EXTERNAL SAXPY, SCOPY, SSCAL, STPMV * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, REAL @@ -206,7 +206,6 @@ SUBROUTINE STPT03( UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, EPS = SLAMCH( 'Epsilon' ) SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Compute the norm of the triangular matrix A using the column * norms already computed by SLATPS. diff --git a/TESTING/LIN/stpt06.f b/TESTING/LIN/stpt06.f index 117987dcc5..e72d1483e2 100644 --- a/TESTING/LIN/stpt06.f +++ b/TESTING/LIN/stpt06.f @@ -138,9 +138,6 @@ SUBROUTINE STPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, WORK, RAT ) * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Executable Statements .. * EPS = SLAMCH( 'Epsilon' ) @@ -177,7 +174,6 @@ SUBROUTINE STPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, WORK, RAT ) * SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) ANORM = SLANTP( 'M', UPLO, DIAG, N, AP, WORK ) * RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) diff --git a/TESTING/LIN/strt03.f b/TESTING/LIN/strt03.f index 2e41076d48..899f45ec93 100644 --- a/TESTING/LIN/strt03.f +++ b/TESTING/LIN/strt03.f @@ -198,7 +198,7 @@ SUBROUTINE STRT03( UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, EXTERNAL LSAME, ISAMAX, SLAMCH * .. * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SLABAD, SSCAL, STRMV + EXTERNAL SAXPY, SCOPY, SSCAL, STRMV * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, REAL @@ -214,7 +214,6 @@ SUBROUTINE STRT03( UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, EPS = SLAMCH( 'Epsilon' ) SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Compute the norm of the triangular matrix A using the column * norms already computed by SLATRS. diff --git a/TESTING/LIN/strt06.f b/TESTING/LIN/strt06.f index 266e835434..60572045b5 100644 --- a/TESTING/LIN/strt06.f +++ b/TESTING/LIN/strt06.f @@ -148,9 +148,6 @@ SUBROUTINE STRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. -* .. External Subroutines .. - EXTERNAL SLABAD -* .. * .. Executable Statements .. * EPS = SLAMCH( 'Epsilon' ) @@ -187,7 +184,6 @@ SUBROUTINE STRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, * SMLNUM = SLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) ANORM = SLANTR( 'M', UPLO, DIAG, N, N, A, LDA, WORK ) * RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) ) diff --git a/TESTING/LIN/zlatb4.f b/TESTING/LIN/zlatb4.f index 6973dc0c85..5001774dbf 100644 --- a/TESTING/LIN/zlatb4.f +++ b/TESTING/LIN/zlatb4.f @@ -154,9 +154,6 @@ SUBROUTINE ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -174,11 +171,6 @@ SUBROUTINE ZLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = DLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL DLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/zlatb5.f b/TESTING/LIN/zlatb5.f index 446d05995f..bf717e8d34 100644 --- a/TESTING/LIN/zlatb5.f +++ b/TESTING/LIN/zlatb5.f @@ -145,9 +145,6 @@ SUBROUTINE ZLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, * .. Intrinsic Functions .. INTRINSIC MAX, SQRT * .. -* .. External Subroutines .. - EXTERNAL DLABAD -* .. * .. Save statement .. SAVE EPS, SMALL, LARGE, BADC1, BADC2, FIRST * .. @@ -165,11 +162,6 @@ SUBROUTINE ZLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, BADC1 = SQRT( BADC2 ) SMALL = DLAMCH( 'Safe minimum' ) LARGE = ONE / SMALL -* -* If it looks like we're on a Cray, take the square root of -* SMALL and LARGE to avoid overflow and underflow problems. -* - CALL DLABAD( SMALL, LARGE ) SMALL = SHRINK*( SMALL / EPS ) LARGE = ONE / SMALL END IF diff --git a/TESTING/LIN/zlattb.f b/TESTING/LIN/zlattb.f index 288a428531..e18fd7fcd7 100644 --- a/TESTING/LIN/zlattb.f +++ b/TESTING/LIN/zlattb.f @@ -177,8 +177,8 @@ SUBROUTINE ZLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, EXTERNAL LSAME, IZAMAX, DLAMCH, DLARND, ZLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4, - $ ZLATMS, ZSWAP + EXTERNAL DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4, ZLATMS, + $ ZSWAP * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, MAX, MIN, SQRT @@ -191,7 +191,6 @@ SUBROUTINE ZLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/zlattp.f b/TESTING/LIN/zlattp.f index e05d9299e8..698b77ad41 100644 --- a/TESTING/LIN/zlattp.f +++ b/TESTING/LIN/zlattp.f @@ -168,8 +168,8 @@ SUBROUTINE ZLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, EXTERNAL LSAME, IZAMAX, DLAMCH, ZLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLARNV, ZDSCAL, ZLARNV, ZLATB4, ZLATMS, - $ ZROT, ZROTG + EXTERNAL DLARNV, ZDSCAL, ZLARNV, ZLATB4, ZLATMS, ZROT, + $ ZROTG * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DCMPLX, DCONJG, MAX, SQRT @@ -182,7 +182,6 @@ SUBROUTINE ZLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/zlattr.f b/TESTING/LIN/zlattr.f index 884eb02758..d5741aa32a 100644 --- a/TESTING/LIN/zlattr.f +++ b/TESTING/LIN/zlattr.f @@ -174,7 +174,7 @@ SUBROUTINE ZLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, EXTERNAL LSAME, IZAMAX, DLAMCH, DLARND, ZLARND * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4, + EXTERNAL DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4, $ ZLATMS, ZROT, ZROTG, ZSWAP * .. * .. Intrinsic Functions .. @@ -188,7 +188,6 @@ SUBROUTINE ZLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) SMLNUM = UNFL BIGNUM = ( ONE-ULP ) / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN DIAG = 'U' ELSE diff --git a/TESTING/LIN/zqrt12.f b/TESTING/LIN/zqrt12.f index 0da6be1576..b128579288 100644 --- a/TESTING/LIN/zqrt12.f +++ b/TESTING/LIN/zqrt12.f @@ -125,8 +125,8 @@ DOUBLE PRECISION FUNCTION ZQRT12( M, N, A, LDA, S, WORK, LWORK, EXTERNAL DASUM, DLAMCH, DNRM2, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DAXPY, DBDSQR, DLABAD, DLASCL, XERBLA, ZGEBD2, - $ ZLASCL, ZLASET + EXTERNAL DAXPY, DBDSQR, DLASCL, XERBLA, ZGEBD2, ZLASCL, + $ ZLASET * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCMPLX, MAX, MIN @@ -164,7 +164,6 @@ DOUBLE PRECISION FUNCTION ZQRT12( M, N, A, LDA, S, WORK, LWORK, * SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Scale work if max entry outside range [SMLNUM,BIGNUM] * diff --git a/TESTING/LIN/zqrt13.f b/TESTING/LIN/zqrt13.f index 341ec17000..c28f2869ab 100644 --- a/TESTING/LIN/zqrt13.f +++ b/TESTING/LIN/zqrt13.f @@ -117,7 +117,7 @@ SUBROUTINE ZQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) EXTERNAL DLAMCH, DZASUM, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZLARNV, ZLASCL + EXTERNAL ZLARNV, ZLASCL * .. * .. Intrinsic Functions .. INTRINSIC DBLE, DCMPLX, SIGN @@ -146,7 +146,6 @@ SUBROUTINE ZQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY ) SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) SMLNUM = SMLNUM / DLAMCH( 'Epsilon' ) BIGNUM = ONE / SMLNUM * diff --git a/TESTING/LIN/zqrt15.f b/TESTING/LIN/zqrt15.f index f58b9e38bc..efea51b944 100644 --- a/TESTING/LIN/zqrt15.f +++ b/TESTING/LIN/zqrt15.f @@ -183,8 +183,8 @@ SUBROUTINE ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, EXTERNAL DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DLABAD, DLAORD, DLASCL, XERBLA, ZDSCAL, ZGEMM, - $ ZLARF, ZLARNV, ZLAROR, ZLASCL, ZLASET + EXTERNAL DLAORD, DLASCL, XERBLA, ZDSCAL, ZGEMM, ZLARF, + $ ZLARNV, ZLAROR, ZLASCL, ZLASET * .. * .. Intrinsic Functions .. INTRINSIC ABS, DCMPLX, MAX, MIN @@ -199,7 +199,6 @@ SUBROUTINE ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, * SMLNUM = DLAMCH( 'Safe minimum' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) EPS = DLAMCH( 'Epsilon' ) SMLNUM = ( SMLNUM / EPS ) / EPS BIGNUM = ONE / SMLNUM