view libcruft/qpsol/rotgen.f @ 2542:484977eb65ad

[project @ 1996-11-20 02:17:08 by jwe]
author jwe
date Wed, 20 Nov 1996 02:18:00 +0000
parents 30c606bec7a8
children
line wrap: on
line source

      SUBROUTINE ROTGEN( X, Y, CS, SN )
C
      DOUBLE PRECISION   X, Y, CS, SN
C
      DOUBLE PRECISION   WMACH
      COMMON    /SOLMCH/ WMACH(15)
C
C  *********************************************************************
C  ROTGEN  GENERATES A PLANE ROTATION THAT REDUCES THE VECTOR (X, Y)
C  TO THE VECTOR (A, 0),  WHERE  A  IS DEFINED AS FOLLOWS...
C
C     IF BOTH X AND Y ARE NEGLIGIBLY SMALL, OR
C     IF Y IS NEGLIGIBLE RELATIVE TO X,
C     THEN  A = X,  AND THE IDENTITY ROTATION IS RETURNED.
C
C     IF X IS NEGLIGIBLE RELATIVE TO Y,
C     THEN  A = Y,  AND THE SWAP ROTATION IS RETURNED.
C
C     OTHERWISE,  A = SIGN(X) * SQRT( X**2 + Y**2 ).
C
C  IN ALL CASES,  X  AND  Y  ARE OVERWRITTEN BY  A  AND  0,
C  AND  CS  WILL LIE IN THE CLOSED INTERVAL  (0, 1).  ALSO,
C  THE ABSOLUTE VALUE OF  CS  AND  SN  (IF NONZERO) WILL BE NO LESS
C  THAN THE MACHINE PRECISION,  EPS.
C
C  ROTGEN  GUARDS AGAINST OVERFLOW AND UNDERFLOW.
C  IT IS ASSUMED THAT  FLMIN .LT. EPS**2  (I.E.  RTMIN .LT. EPS).
C
C  SYSTEMS OPTIMIZATION LABORATORY, STANFORD UNIVERSITY.
C  VERSION OF JANUARY 1982.
C  *********************************************************************
C
      DOUBLE PRECISION   A, B, EPS, ONE, RTMIN, ZERO
      DOUBLE PRECISION   DSQRT
      DOUBLE PRECISION   DABS, DMAX1
      DATA               ONE/1.0D+0/, ZERO/0.0D+0/
C
      IF (Y .EQ. ZERO) GO TO 100
      IF (X .EQ. ZERO) GO TO 200
C
      EPS    = WMACH(3)
      RTMIN  = WMACH(6)
      A      = DABS(X)
      B      = DABS(Y)
      IF (DMAX1(A,B) .LE. RTMIN) GO TO 100
      IF (A .LT. B) GO TO 50
      IF (B .LE. EPS*A) GO TO 100
      A  = A * DSQRT( ONE + (B/A)**2 )
      GO TO 60
C
   50 IF (A .LE. EPS*B) GO TO 200
      A  = B * DSQRT( ONE + (A/B)**2 )
C
   60 IF (X .LT. ZERO) A = - A
      CS = X/A
      SN = Y/A
      X  = A
      GO TO 300
C
  100 CS = ONE
      SN = ZERO
      GO TO 300
C
  200 CS = ZERO
      SN = ONE
      X  = Y
  300 Y  = ZERO
      RETURN
C
C  END OF ROTGEN
      END