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.NE.0.0d0) GO TO 10
00028       C = 1.0d0
00029       S = 0.0d0
00030       R = 0.0d0
00031       Z = 0.0d0
00032       GO TO 20
00033    10 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    20 DA = R
00041       DB = Z
00042       RETURN
00043       END