Numérotation des lignes :

C DLARTG    SOURCE    BP208322  18/07/10    21:15:16     9872           *> \brief \b DLARTG generates a plane rotation with real cosine and real sine.**  =========== DOCUMENTATION ===========** Online html documentation available at*            http://www.netlib.org/lapack/explore-html/**> \htmlonly*> Download DLARTG + dependencies*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartg.f">*> [TGZ]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartg.f">*> [ZIP]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartg.f">*> [TXT]&lt;/a>*> \endhtmlonly**  Definition:*  ===========**       SUBROUTINE DLARTG( F, G, CS, SN, R )**       .. Scalar Arguments ..*       REAL*8   CS, F, G, R, SN*       ..***> \par Purpose:*  =============*>*> \verbatim*>*> DLARTG generate a plane rotation so that*>*>    [  CS  SN  ]  .  [ F ]  =  [ R ]   where CS**2 + SN**2 = 1.*>    [ -SN  CS  ]     [ G ]     [ 0 ]*>*> This is a slower, more accurate version of the BLAS1 routine DROTG,*> with the following other differences:*>    F and G are unchanged on return.*>    If G=0, then CS=1 and SN=0.*>    If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any*>       floating point operations (saves work in DBDSQR when*>       there are zeros on the diagonal).*>*> If F exceeds G in magnitude, CS will be positive.*> \endverbatim**  Arguments:*  ==========**> \param[in] F*> \verbatim*>          F is DOUBLE PRECISION*>          The first component of vector to be rotated.*> \endverbatim*>*> \param[in] G*> \verbatim*>          G is DOUBLE PRECISION*>          The second component of vector to be rotated.*> \endverbatim*>*> \param[out] CS*> \verbatim*>          CS is DOUBLE PRECISION*>          The cosine of the rotation.*> \endverbatim*>*> \param[out] SN*> \verbatim*>          SN is DOUBLE PRECISION*>          The sine of the rotation.*> \endverbatim*>*> \param[out] R*> \verbatim*>          R is DOUBLE PRECISION*>          The nonzero component of the rotated vector.*>*>  This version has a few statements commented out for thread safety*>  (machine parameters are computed on each entry). 10 feb 03, SJH.*> \endverbatim**  Authors:*  ========**> \author Univ. of Tennessee*> \author Univ. of California Berkeley*> \author Univ. of Colorado Denver*> \author NAG Ltd.**> \date December 2016**> \ingroup OTHERauxiliary**  =====================================================================      SUBROUTINE DLARTG( F, G, CS, SN, R )**  -- LAPACK auxiliary routine (version 3.7.0) --*  -- LAPACK is a software package provided by Univ. of Tennessee,    --*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--*     December 2016**     .. Scalar Arguments ..      REAL*8   CS, F, G, R, SN*     ..**  =====================================================================**     .. Parameters ..      REAL*8   ZERO      PARAMETER          ( ZERO = 0.0D0 )      REAL*8   ONE      PARAMETER          ( ONE = 1.0D0 )      REAL*8   TWO      PARAMETER          ( TWO = 2.0D0 )*     ..*     .. Local Scalars ..      LOGICAL            FIRST      INTEGER            COUNT, I      REAL*8   EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE*     ..*     .. External Functions ..      REAL*8   DLAMCH      EXTERNAL           DLAMCH*     ..**     .. Intrinsic Functions ..*      INTRINSIC          ABS, INT, LOG, MAX, SQRT**     ..**     .. Save statement ..c        SAVE               FIRST, SAFMX2, SAFMIN, SAFMN2**     ..**     .. Data statements ..c        DATA               FIRST / .TRUE. /**     ..**     .. Executable Statements ..*c        IF( FIRST ) THEN         SAFMIN = DLAMCH( 'S' )         EPS = DLAMCH( 'E' )         SAFMN2 = DLAMCH( 'B' )**INT( LOG( SAFMIN / EPS ) /     $LOG( DLAMCH( 'B' ) ) / TWO ) SAFMX2 = ONE / SAFMN2c FIRST = .FALSE.c END IF IF( G.EQ.ZERO ) THEN CS = ONE SN = ZERO R = F ELSE IF( F.EQ.ZERO ) THEN CS = ZERO SN = ONE R = G ELSE F1 = F G1 = G SCALE = MAX( ABS( F1 ), ABS( G1 ) ) IF( SCALE.GE.SAFMX2 ) THEN COUNT = 0 10 CONTINUE COUNT = COUNT + 1 F1 = F1*SAFMN2 G1 = G1*SAFMN2 SCALE = MAX( ABS( F1 ), ABS( G1 ) ) IF( SCALE.GE.SAFMX2 )$         GO TO 10            R = SQRT( F1**2+G1**2 )            CS = F1 / R            SN = G1 / R            DO 20 I = 1, COUNT               R = R*SAFMX2   20       CONTINUE         ELSE IF( SCALE.LE.SAFMN2 ) THEN            COUNT = 0   30       CONTINUE            COUNT = COUNT + 1            F1 = F1*SAFMX2            G1 = G1*SAFMX2            SCALE = MAX( ABS( F1 ), ABS( G1 ) )            IF( SCALE.LE.SAFMN2 )     \$         GO TO 30            R = SQRT( F1**2+G1**2 )            CS = F1 / R            SN = G1 / R            DO 40 I = 1, COUNT               R = R*SAFMN2   40       CONTINUE         ELSE            R = SQRT( F1**2+G1**2 )            CS = F1 / R            SN = G1 / R         END IF         IF( ABS( F ).GT.ABS( G ) .AND. CS.LT.ZERO ) THEN            CS = -CS            SN = -SN            R = -R         END IF      END IF      RETURN**     End of DLARTG*      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales