Annotation of rpl/lapack/blas/drotmg.f, revision 1.1

1.1     ! bertrand    1:       SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
        !             2: *     .. Scalar Arguments ..
        !             3:       DOUBLE PRECISION DD1,DD2,DX1,DY1
        !             4: *     ..
        !             5: *     .. Array Arguments ..
        !             6:       DOUBLE PRECISION DPARAM(5)
        !             7: *     ..
        !             8: *
        !             9: *  Purpose
        !            10: *  =======
        !            11: *
        !            12: *     CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
        !            13: *     THE SECOND COMPONENT OF THE 2-VECTOR  (DSQRT(DD1)*DX1,DSQRT(DD2)*
        !            14: *     DY2)**T.
        !            15: *     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
        !            16: *
        !            17: *     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0
        !            18: *
        !            19: *       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0)
        !            20: *     H=(          )    (          )    (          )    (          )
        !            21: *       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
        !            22: *     LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
        !            23: *     RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
        !            24: *     VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
        !            25: *
        !            26: *     THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
        !            27: *     INEXACT.  THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
        !            28: *     OF DD1 AND DD2.  ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
        !            29: *
        !            30: *
        !            31: *  Arguments
        !            32: *  =========
        !            33: *
        !            34: *  DD1    (input/output) DOUBLE PRECISION
        !            35: *
        !            36: *  DD2    (input/output) DOUBLE PRECISION 
        !            37: *
        !            38: *  DX1    (input/output) DOUBLE PRECISION 
        !            39: *
        !            40: *  DY1    (input) DOUBLE PRECISION
        !            41: *
        !            42: *  DPARAM (input/output)  DOUBLE PRECISION array, dimension 5
        !            43: *     DPARAM(1)=DFLAG
        !            44: *     DPARAM(2)=DH11
        !            45: *     DPARAM(3)=DH21
        !            46: *     DPARAM(4)=DH12
        !            47: *     DPARAM(5)=DH22
        !            48: *
        !            49: *  =====================================================================
        !            50: *
        !            51: *     .. Local Scalars ..
        !            52:       DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,
        !            53:      +                 DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO
        !            54:       INTEGER IGO
        !            55: *     ..
        !            56: *     .. Intrinsic Functions ..
        !            57:       INTRINSIC DABS
        !            58: *     ..
        !            59: *     .. Data statements ..
        !            60: *
        !            61:       DATA ZERO,ONE,TWO/0.D0,1.D0,2.D0/
        !            62:       DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
        !            63: *     ..
        !            64: 
        !            65:       IF (.NOT.DD1.LT.ZERO) GO TO 10
        !            66: *       GO ZERO-H-D-AND-DX1..
        !            67:       GO TO 60
        !            68:    10 CONTINUE
        !            69: *     CASE-DD1-NONNEGATIVE
        !            70:       DP2 = DD2*DY1
        !            71:       IF (.NOT.DP2.EQ.ZERO) GO TO 20
        !            72:       DFLAG = -TWO
        !            73:       GO TO 260
        !            74: *     REGULAR-CASE..
        !            75:    20 CONTINUE
        !            76:       DP1 = DD1*DX1
        !            77:       DQ2 = DP2*DY1
        !            78:       DQ1 = DP1*DX1
        !            79: *
        !            80:       IF (.NOT.DABS(DQ1).GT.DABS(DQ2)) GO TO 40
        !            81:       DH21 = -DY1/DX1
        !            82:       DH12 = DP2/DP1
        !            83: *
        !            84:       DU = ONE - DH12*DH21
        !            85: *
        !            86:       IF (.NOT.DU.LE.ZERO) GO TO 30
        !            87: *         GO ZERO-H-D-AND-DX1..
        !            88:       GO TO 60
        !            89:    30 CONTINUE
        !            90:       DFLAG = ZERO
        !            91:       DD1 = DD1/DU
        !            92:       DD2 = DD2/DU
        !            93:       DX1 = DX1*DU
        !            94: *         GO SCALE-CHECK..
        !            95:       GO TO 100
        !            96:    40 CONTINUE
        !            97:       IF (.NOT.DQ2.LT.ZERO) GO TO 50
        !            98: *         GO ZERO-H-D-AND-DX1..
        !            99:       GO TO 60
        !           100:    50 CONTINUE
        !           101:       DFLAG = ONE
        !           102:       DH11 = DP1/DP2
        !           103:       DH22 = DX1/DY1
        !           104:       DU = ONE + DH11*DH22
        !           105:       DTEMP = DD2/DU
        !           106:       DD2 = DD1/DU
        !           107:       DD1 = DTEMP
        !           108:       DX1 = DY1*DU
        !           109: *         GO SCALE-CHECK
        !           110:       GO TO 100
        !           111: *     PROCEDURE..ZERO-H-D-AND-DX1..
        !           112:    60 CONTINUE
        !           113:       DFLAG = -ONE
        !           114:       DH11 = ZERO
        !           115:       DH12 = ZERO
        !           116:       DH21 = ZERO
        !           117:       DH22 = ZERO
        !           118: *
        !           119:       DD1 = ZERO
        !           120:       DD2 = ZERO
        !           121:       DX1 = ZERO
        !           122: *         RETURN..
        !           123:       GO TO 220
        !           124: *     PROCEDURE..FIX-H..
        !           125:    70 CONTINUE
        !           126:       IF (.NOT.DFLAG.GE.ZERO) GO TO 90
        !           127: *
        !           128:       IF (.NOT.DFLAG.EQ.ZERO) GO TO 80
        !           129:       DH11 = ONE
        !           130:       DH22 = ONE
        !           131:       DFLAG = -ONE
        !           132:       GO TO 90
        !           133:    80 CONTINUE
        !           134:       DH21 = -ONE
        !           135:       DH12 = ONE
        !           136:       DFLAG = -ONE
        !           137:    90 CONTINUE
        !           138:       GO TO IGO(120,150,180,210)
        !           139: *     PROCEDURE..SCALE-CHECK
        !           140:   100 CONTINUE
        !           141:   110 CONTINUE
        !           142:       IF (.NOT.DD1.LE.RGAMSQ) GO TO 130
        !           143:       IF (DD1.EQ.ZERO) GO TO 160
        !           144:       ASSIGN 120 TO IGO
        !           145: *              FIX-H..
        !           146:       GO TO 70
        !           147:   120 CONTINUE
        !           148:       DD1 = DD1*GAM**2
        !           149:       DX1 = DX1/GAM
        !           150:       DH11 = DH11/GAM
        !           151:       DH12 = DH12/GAM
        !           152:       GO TO 110
        !           153:   130 CONTINUE
        !           154:   140 CONTINUE
        !           155:       IF (.NOT.DD1.GE.GAMSQ) GO TO 160
        !           156:       ASSIGN 150 TO IGO
        !           157: *              FIX-H..
        !           158:       GO TO 70
        !           159:   150 CONTINUE
        !           160:       DD1 = DD1/GAM**2
        !           161:       DX1 = DX1*GAM
        !           162:       DH11 = DH11*GAM
        !           163:       DH12 = DH12*GAM
        !           164:       GO TO 140
        !           165:   160 CONTINUE
        !           166:   170 CONTINUE
        !           167:       IF (.NOT.DABS(DD2).LE.RGAMSQ) GO TO 190
        !           168:       IF (DD2.EQ.ZERO) GO TO 220
        !           169:       ASSIGN 180 TO IGO
        !           170: *              FIX-H..
        !           171:       GO TO 70
        !           172:   180 CONTINUE
        !           173:       DD2 = DD2*GAM**2
        !           174:       DH21 = DH21/GAM
        !           175:       DH22 = DH22/GAM
        !           176:       GO TO 170
        !           177:   190 CONTINUE
        !           178:   200 CONTINUE
        !           179:       IF (.NOT.DABS(DD2).GE.GAMSQ) GO TO 220
        !           180:       ASSIGN 210 TO IGO
        !           181: *              FIX-H..
        !           182:       GO TO 70
        !           183:   210 CONTINUE
        !           184:       DD2 = DD2/GAM**2
        !           185:       DH21 = DH21*GAM
        !           186:       DH22 = DH22*GAM
        !           187:       GO TO 200
        !           188:   220 CONTINUE
        !           189:       IF (DFLAG) 250,230,240
        !           190:   230 CONTINUE
        !           191:       DPARAM(3) = DH21
        !           192:       DPARAM(4) = DH12
        !           193:       GO TO 260
        !           194:   240 CONTINUE
        !           195:       DPARAM(2) = DH11
        !           196:       DPARAM(5) = DH22
        !           197:       GO TO 260
        !           198:   250 CONTINUE
        !           199:       DPARAM(2) = DH11
        !           200:       DPARAM(3) = DH21
        !           201:       DPARAM(4) = DH12
        !           202:       DPARAM(5) = DH22
        !           203:   260 CONTINUE
        !           204:       DPARAM(1) = DFLAG
        !           205:       RETURN
        !           206:       END

CVSweb interface <joel.bertrand@systella.fr>