de/d13/drotg_8f_source.html

00001       SUBROUTINE DROTG(DA,DB,C,S)
00002 *     .. Scalar Arguments ..
00003       DOUBLE PRECISION C,DA,DB,S
00004 *     ..
00005 *
00006 *  Purpose
00007 *  =======
00008 *
00009 *     DROTG construct givens plane rotation.
00010 *
00011 *  Further Details
00012 *  ===============
00013 *
00014 *     jack dongarra, linpack, 3/11/78.
00015 *
00016 *  =====================================================================
00017 *
00018 *     .. Local Scalars ..
00019       DOUBLE PRECISION R,ROE,SCALE,Z
00020 *     ..
00021 *     .. Intrinsic Functions ..
00022       INTRINSIC DABS,DSIGN,DSQRT
00023 *     ..
00024       ROE = DB
00025       IF (DABS(DA).GT.DABS(DB)) ROE = DA
00026       SCALE = DABS(DA) + DABS(DB)
00027       IF (SCALE.EQ.0.0d0) THEN
00028          C = 1.0d0
00029          S = 0.0d0
00030          R = 0.0d0
00031          Z = 0.0d0
00032       ELSE
00033          R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)
00034          R = DSIGN(1.0d0,ROE)*R
00035          C = DA/R
00036          S = DB/R
00037          Z = 1.0d0
00038          IF (DABS(DA).GT.DABS(DB)) Z = S
00039          IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C
00040       END IF
00041       DA = R
00042       DB = Z
00043       RETURN
00044       END