--- rpl/lapack/lapack/dgesdd.f 2016/08/27 15:34:22 1.17 +++ rpl/lapack/lapack/dgesdd.f 2023/08/07 08:38:49 1.22 @@ -2,25 +2,25 @@ * * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DGESDD + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DGESDD + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, * WORK, LWORK, IWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER JOBZ * INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N @@ -30,7 +30,7 @@ * DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ), * $ VT( LDVT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -191,20 +191,19 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit. -*> < 0: if INFO = -i, the i-th argument had an illegal value. -*> > 0: DBDSDC did not converge, updating process failed. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> = -4: if A had a NAN entry. +*> > 0: DBDSDC did not converge, updating process failed. +*> = 0: successful exit. *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date June 2016 +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \ingroup doubleGEsing * @@ -214,16 +213,14 @@ *> Ming Gu and Huan Ren, Computer Science Division, University of *> California at Berkeley, USA *> -*> @precisions fortran d -> s * ===================================================================== SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ WORK, LWORK, IWORK, INFO ) implicit none * -* -- LAPACK driver routine (version 3.6.1) -- +* -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -247,7 +244,7 @@ $ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR, NWORK, WRKBL - INTEGER LWORK_DGEBRD_MN, LWORK_DGEBRD_MM, + INTEGER LWORK_DGEBRD_MN, LWORK_DGEBRD_MM, $ LWORK_DGEBRD_NN, LWORK_DGELQF_MN, $ LWORK_DGEQRF_MN, $ LWORK_DORGBR_P_MM, LWORK_DORGBR_Q_NN, @@ -268,9 +265,10 @@ $ XERBLA * .. * .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL DLAMCH, DLANGE, LSAME + LOGICAL LSAME, DISNAN + DOUBLE PRECISION DLAMCH, DLANGE, DROUNDUP_LWORK + EXTERNAL DLAMCH, DLANGE, LSAME, DISNAN, + $ DROUNDUP_LWORK * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -323,7 +321,7 @@ * IF( WNTQN ) THEN * dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) -* keep 7*N for backwards compatability. +* keep 7*N for backwards compatibility. BDSPAC = 7*N ELSE BDSPAC = 3*N*N + 4*N @@ -449,7 +447,7 @@ * IF( WNTQN ) THEN * dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) -* keep 7*N for backwards compatability. +* keep 7*N for backwards compatibility. BDSPAC = 7*M ELSE BDSPAC = 3*M*M + 4*M @@ -569,9 +567,9 @@ END IF END IF END IF - + MAXWRK = MAX( MAXWRK, MINWRK ) - WORK( 1 ) = MAXWRK + WORK( 1 ) = DROUNDUP_LWORK( MAXWRK ) * IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN INFO = -12 @@ -600,6 +598,10 @@ * Scale A if max element outside range [SMLNUM,BIGNUM] * ANRM = DLANGE( 'M', M, N, A, LDA, DUM ) + IF( DISNAN( ANRM ) ) THEN + INFO = -4 + RETURN + END IF ISCL = 0 IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN ISCL = 1 @@ -1540,7 +1542,7 @@ * * Return optimal workspace in WORK(1) * - WORK( 1 ) = MAXWRK + WORK( 1 ) = DROUNDUP_LWORK( MAXWRK ) * RETURN *