[BACK]Return to drotmg.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / blas

Diff for /rpl/lapack/blas/drotmg.f between versions 1.2 and 1.8

version 1.2, 2010/04/21 13:45:09 version 1.8, 2011/07/22 07:38:01
Line 33 Line 33
 *  *
 *  DD1    (input/output) DOUBLE PRECISION  *  DD1    (input/output) DOUBLE PRECISION
 *  *
 *  DD2    (input/output) DOUBLE PRECISION   *  DD2    (input/output) DOUBLE PRECISION
 *  *
 *  DX1    (input/output) DOUBLE PRECISION   *  DX1    (input/output) DOUBLE PRECISION
 *  *
 *  DY1    (input) DOUBLE PRECISION  *  DY1    (input) DOUBLE PRECISION
 *  *
Line 50 Line 50
 *  *
 *     .. Local Scalars ..  *     .. Local Scalars ..
       DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,        DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,
      +                 DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO       $                 DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO
       INTEGER IGO  
 *     ..  *     ..
 *     .. Intrinsic Functions ..  *     .. Intrinsic Functions ..
       INTRINSIC DABS        INTRINSIC DABS
Line 62 Line 61
       DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/        DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
 *     ..  *     ..
   
       IF (.NOT.DD1.LT.ZERO) GO TO 10        IF (DD1.LT.ZERO) THEN
 *       GO ZERO-H-D-AND-DX1..  *        GO ZERO-H-D-AND-DX1..
       GO TO 60           DFLAG = -ONE
    10 CONTINUE           DH11 = ZERO
 *     CASE-DD1-NONNEGATIVE           DH12 = ZERO
       DP2 = DD2*DY1           DH21 = ZERO
       IF (.NOT.DP2.EQ.ZERO) GO TO 20           DH22 = ZERO
       DFLAG = -TWO  *
       GO TO 260           DD1 = ZERO
 *     REGULAR-CASE..           DD2 = ZERO
    20 CONTINUE           DX1 = ZERO
       DP1 = DD1*DX1        ELSE
       DQ2 = DP2*DY1  *        CASE-DD1-NONNEGATIVE
       DQ1 = DP1*DX1           DP2 = DD2*DY1
 *           IF (DP2.EQ.ZERO) THEN
       IF (.NOT.DABS(DQ1).GT.DABS(DQ2)) GO TO 40              DFLAG = -TWO
       DH21 = -DY1/DX1              DPARAM(1) = DFLAG
       DH12 = DP2/DP1              RETURN
 *           END IF 
       DU = ONE - DH12*DH21  *        REGULAR-CASE..
 *           DP1 = DD1*DX1
       IF (.NOT.DU.LE.ZERO) GO TO 30           DQ2 = DP2*DY1
 *         GO ZERO-H-D-AND-DX1..           DQ1 = DP1*DX1
       GO TO 60  *
    30 CONTINUE           IF (DABS(DQ1).GT.DABS(DQ2)) THEN
       DFLAG = ZERO              DH21 = -DY1/DX1
       DD1 = DD1/DU              DH12 = DP2/DP1
       DD2 = DD2/DU  *
       DX1 = DX1*DU              DU = ONE - DH12*DH21
 *         GO SCALE-CHECK..  *
       GO TO 100             IF (DU.GT.ZERO) THEN
    40 CONTINUE               DFLAG = ZERO
       IF (.NOT.DQ2.LT.ZERO) GO TO 50               DD1 = DD1/DU
 *         GO ZERO-H-D-AND-DX1..               DD2 = DD2/DU
       GO TO 60               DX1 = DX1*DU
    50 CONTINUE             END IF
       DFLAG = ONE           ELSE
       DH11 = DP1/DP2  
       DH22 = DX1/DY1              IF (DQ2.LT.ZERO) THEN
       DU = ONE + DH11*DH22  *              GO ZERO-H-D-AND-DX1..
       DTEMP = DD2/DU                 DFLAG = -ONE
       DD2 = DD1/DU                 DH11 = ZERO
       DD1 = DTEMP                 DH12 = ZERO
       DX1 = DY1*DU                 DH21 = ZERO
 *         GO SCALE-CHECK                 DH22 = ZERO
       GO TO 100  *
 *     PROCEDURE..ZERO-H-D-AND-DX1..                 DD1 = ZERO
    60 CONTINUE                 DD2 = ZERO
       DFLAG = -ONE                 DX1 = ZERO
       DH11 = ZERO              ELSE
       DH12 = ZERO                 DFLAG = ONE
       DH21 = ZERO                 DH11 = DP1/DP2
       DH22 = ZERO                 DH22 = DX1/DY1
 *                 DU = ONE + DH11*DH22
       DD1 = ZERO                 DTEMP = DD2/DU
       DD2 = ZERO                 DD2 = DD1/DU
       DX1 = ZERO                 DD1 = DTEMP
 *         RETURN..                 DX1 = DY1*DU
       GO TO 220              END IF
 *     PROCEDURE..FIX-H..           END IF
    70 CONTINUE  
       IF (.NOT.DFLAG.GE.ZERO) GO TO 90  
 *  
       IF (.NOT.DFLAG.EQ.ZERO) GO TO 80  
       DH11 = ONE  
       DH22 = ONE  
       DFLAG = -ONE  
       GO TO 90  
    80 CONTINUE  
       DH21 = -ONE  
       DH12 = ONE  
       DFLAG = -ONE  
    90 CONTINUE  
       GO TO IGO(120,150,180,210)  
 *     PROCEDURE..SCALE-CHECK  *     PROCEDURE..SCALE-CHECK
   100 CONTINUE           IF (DD1.NE.ZERO) THEN
   110 CONTINUE              DO WHILE ((DD1.LE.RGAMSQ) .OR. (DD1.GE.GAMSQ))
       IF (.NOT.DD1.LE.RGAMSQ) GO TO 130                 IF (DFLAG.EQ.ZERO) THEN
       IF (DD1.EQ.ZERO) GO TO 160                    DH11 = ONE
       ASSIGN 120 TO IGO                    DH22 = ONE
 *              FIX-H..                    DFLAG = -ONE
       GO TO 70                 ELSE
   120 CONTINUE                    DH21 = -ONE
       DD1 = DD1*GAM**2                    DH12 = ONE
       DX1 = DX1/GAM                    DFLAG = -ONE
       DH11 = DH11/GAM                 END IF
       DH12 = DH12/GAM                 IF (DD1.LE.RGAMSQ) THEN
       GO TO 110                    DD1 = DD1*GAM**2
   130 CONTINUE                    DX1 = DX1/GAM
   140 CONTINUE                    DH11 = DH11/GAM
       IF (.NOT.DD1.GE.GAMSQ) GO TO 160                    DH12 = DH12/GAM
       ASSIGN 150 TO IGO                 ELSE
 *              FIX-H..                    DD1 = DD1/GAM**2
       GO TO 70                    DX1 = DX1*GAM
   150 CONTINUE                    DH11 = DH11*GAM
       DD1 = DD1/GAM**2                    DH12 = DH12*GAM
       DX1 = DX1*GAM                 END IF
       DH11 = DH11*GAM              ENDDO
       DH12 = DH12*GAM           END IF
       GO TO 140    
   160 CONTINUE           IF (DD2.NE.ZERO) THEN
   170 CONTINUE              DO WHILE ( (DABS(DD2).LE.RGAMSQ) .OR. (DABS(DD2).GE.GAMSQ) )
       IF (.NOT.DABS(DD2).LE.RGAMSQ) GO TO 190                 IF (DFLAG.EQ.ZERO) THEN
       IF (DD2.EQ.ZERO) GO TO 220                    DH11 = ONE
       ASSIGN 180 TO IGO                    DH22 = ONE
 *              FIX-H..                    DFLAG = -ONE
       GO TO 70                 ELSE
   180 CONTINUE                    DH21 = -ONE
       DD2 = DD2*GAM**2                    DH12 = ONE
       DH21 = DH21/GAM                    DFLAG = -ONE
       DH22 = DH22/GAM                 END IF
       GO TO 170                 IF (DABS(DD2).LE.RGAMSQ) THEN
   190 CONTINUE                    DD2 = DD2*GAM**2
   200 CONTINUE                    DH21 = DH21/GAM
       IF (.NOT.DABS(DD2).GE.GAMSQ) GO TO 220                    DH22 = DH22/GAM
       ASSIGN 210 TO IGO                 ELSE
 *              FIX-H..                    DD2 = DD2/GAM**2
       GO TO 70                    DH21 = DH21*GAM
   210 CONTINUE                    DH22 = DH22*GAM
       DD2 = DD2/GAM**2                 END IF      
       DH21 = DH21*GAM              END DO
       DH22 = DH22*GAM           END IF
       GO TO 200       
   220 CONTINUE        END IF
       IF (DFLAG) 250,230,240  
   230 CONTINUE        IF (DFLAG.LT.ZERO) THEN
       DPARAM(3) = DH21           DPARAM(2) = DH11
       DPARAM(4) = DH12           DPARAM(3) = DH21
       GO TO 260           DPARAM(4) = DH12
   240 CONTINUE           DPARAM(5) = DH22
       DPARAM(2) = DH11        ELSE IF (DFLAG.EQ.ZERO) THEN
       DPARAM(5) = DH22           DPARAM(3) = DH21
       GO TO 260           DPARAM(4) = DH12 
   250 CONTINUE        ELSE
       DPARAM(2) = DH11           DPARAM(2) = DH11
       DPARAM(3) = DH21           DPARAM(5) = DH22
       DPARAM(4) = DH12        END IF
       DPARAM(5) = DH22  
   260 CONTINUE    260 CONTINUE
       DPARAM(1) = DFLAG        DPARAM(1) = DFLAG
       RETURN        RETURN
       END        END
         
        
        
        
Removed from v.1.2  
changed lines
  Added in v.1.8

CVSweb interface <joel.bertrand@systella.fr>