mirror of
https://gitlab.com/libeigen/eigen.git
synced 2026-04-10 11:34:33 +08:00
import reference BLAS routines which are not already implemented in Eigen : modified givens rotations, and packed and banded storages
This commit is contained in:
Gael Guennebaud
206
blas/drotmg.f
Normal file
206
blas/drotmg.f
Normal file
@@ -0,0 +1,206 @@
|
||||
SUBROUTINE DROTMG(DD1,DD2,DX1,DY1,DPARAM)
|
||||
* .. Scalar Arguments ..
|
||||
DOUBLE PRECISION DD1,DD2,DX1,DY1
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION DPARAM(5)
|
||||
* ..
|
||||
*
|
||||
* Purpose
|
||||
* =======
|
||||
*
|
||||
* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS
|
||||
* THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)*
|
||||
* DY2)**T.
|
||||
* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
|
||||
*
|
||||
* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
|
||||
*
|
||||
* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
|
||||
* H=( ) ( ) ( ) ( )
|
||||
* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
|
||||
* LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22
|
||||
* RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE
|
||||
* VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.)
|
||||
*
|
||||
* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE
|
||||
* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE
|
||||
* OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM.
|
||||
*
|
||||
*
|
||||
* Arguments
|
||||
* =========
|
||||
*
|
||||
* DD1 (input/output) DOUBLE PRECISION
|
||||
*
|
||||
* DD2 (input/output) DOUBLE PRECISION
|
||||
*
|
||||
* DX1 (input/output) DOUBLE PRECISION
|
||||
*
|
||||
* DY1 (input) DOUBLE PRECISION
|
||||
*
|
||||
* DPARAM (input/output) DOUBLE PRECISION array, dimension 5
|
||||
* DPARAM(1)=DFLAG
|
||||
* DPARAM(2)=DH11
|
||||
* DPARAM(3)=DH21
|
||||
* DPARAM(4)=DH12
|
||||
* DPARAM(5)=DH22
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Local Scalars ..
|
||||
DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,
|
||||
+ DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO
|
||||
INTEGER IGO
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC DABS
|
||||
* ..
|
||||
* .. Data statements ..
|
||||
*
|
||||
DATA ZERO,ONE,TWO/0.D0,1.D0,2.D0/
|
||||
DATA GAM,GAMSQ,RGAMSQ/4096.D0,16777216.D0,5.9604645D-8/
|
||||
* ..
|
||||
|
||||
IF (.NOT.DD1.LT.ZERO) GO TO 10
|
||||
* GO ZERO-H-D-AND-DX1..
|
||||
GO TO 60
|
||||
10 CONTINUE
|
||||
* CASE-DD1-NONNEGATIVE
|
||||
DP2 = DD2*DY1
|
||||
IF (.NOT.DP2.EQ.ZERO) GO TO 20
|
||||
DFLAG = -TWO
|
||||
GO TO 260
|
||||
* REGULAR-CASE..
|
||||
20 CONTINUE
|
||||
DP1 = DD1*DX1
|
||||
DQ2 = DP2*DY1
|
||||
DQ1 = DP1*DX1
|
||||
*
|
||||
IF (.NOT.DABS(DQ1).GT.DABS(DQ2)) GO TO 40
|
||||
DH21 = -DY1/DX1
|
||||
DH12 = DP2/DP1
|
||||
*
|
||||
DU = ONE - DH12*DH21
|
||||
*
|
||||
IF (.NOT.DU.LE.ZERO) GO TO 30
|
||||
* GO ZERO-H-D-AND-DX1..
|
||||
GO TO 60
|
||||
30 CONTINUE
|
||||
DFLAG = ZERO
|
||||
DD1 = DD1/DU
|
||||
DD2 = DD2/DU
|
||||
DX1 = DX1*DU
|
||||
* GO SCALE-CHECK..
|
||||
GO TO 100
|
||||
40 CONTINUE
|
||||
IF (.NOT.DQ2.LT.ZERO) GO TO 50
|
||||
* GO ZERO-H-D-AND-DX1..
|
||||
GO TO 60
|
||||
50 CONTINUE
|
||||
DFLAG = ONE
|
||||
DH11 = DP1/DP2
|
||||
DH22 = DX1/DY1
|
||||
DU = ONE + DH11*DH22
|
||||
DTEMP = DD2/DU
|
||||
DD2 = DD1/DU
|
||||
DD1 = DTEMP
|
||||
DX1 = DY1*DU
|
||||
* GO SCALE-CHECK
|
||||
GO TO 100
|
||||
* PROCEDURE..ZERO-H-D-AND-DX1..
|
||||
60 CONTINUE
|
||||
DFLAG = -ONE
|
||||
DH11 = ZERO
|
||||
DH12 = ZERO
|
||||
DH21 = ZERO
|
||||
DH22 = ZERO
|
||||
*
|
||||
DD1 = ZERO
|
||||
DD2 = ZERO
|
||||
DX1 = ZERO
|
||||
* RETURN..
|
||||
GO TO 220
|
||||
* PROCEDURE..FIX-H..
|
||||
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
|
||||
100 CONTINUE
|
||||
110 CONTINUE
|
||||
IF (.NOT.DD1.LE.RGAMSQ) GO TO 130
|
||||
IF (DD1.EQ.ZERO) GO TO 160
|
||||
ASSIGN 120 TO IGO
|
||||
* FIX-H..
|
||||
GO TO 70
|
||||
120 CONTINUE
|
||||
DD1 = DD1*GAM**2
|
||||
DX1 = DX1/GAM
|
||||
DH11 = DH11/GAM
|
||||
DH12 = DH12/GAM
|
||||
GO TO 110
|
||||
130 CONTINUE
|
||||
140 CONTINUE
|
||||
IF (.NOT.DD1.GE.GAMSQ) GO TO 160
|
||||
ASSIGN 150 TO IGO
|
||||
* FIX-H..
|
||||
GO TO 70
|
||||
150 CONTINUE
|
||||
DD1 = DD1/GAM**2
|
||||
DX1 = DX1*GAM
|
||||
DH11 = DH11*GAM
|
||||
DH12 = DH12*GAM
|
||||
GO TO 140
|
||||
160 CONTINUE
|
||||
170 CONTINUE
|
||||
IF (.NOT.DABS(DD2).LE.RGAMSQ) GO TO 190
|
||||
IF (DD2.EQ.ZERO) GO TO 220
|
||||
ASSIGN 180 TO IGO
|
||||
* FIX-H..
|
||||
GO TO 70
|
||||
180 CONTINUE
|
||||
DD2 = DD2*GAM**2
|
||||
DH21 = DH21/GAM
|
||||
DH22 = DH22/GAM
|
||||
GO TO 170
|
||||
190 CONTINUE
|
||||
200 CONTINUE
|
||||
IF (.NOT.DABS(DD2).GE.GAMSQ) GO TO 220
|
||||
ASSIGN 210 TO IGO
|
||||
* FIX-H..
|
||||
GO TO 70
|
||||
210 CONTINUE
|
||||
DD2 = DD2/GAM**2
|
||||
DH21 = DH21*GAM
|
||||
DH22 = DH22*GAM
|
||||
GO TO 200
|
||||
220 CONTINUE
|
||||
IF (DFLAG) 250,230,240
|
||||
230 CONTINUE
|
||||
DPARAM(3) = DH21
|
||||
DPARAM(4) = DH12
|
||||
GO TO 260
|
||||
240 CONTINUE
|
||||
DPARAM(2) = DH11
|
||||
DPARAM(5) = DH22
|
||||
GO TO 260
|
||||
250 CONTINUE
|
||||
DPARAM(2) = DH11
|
||||
DPARAM(3) = DH21
|
||||
DPARAM(4) = DH12
|
||||
DPARAM(5) = DH22
|
||||
260 CONTINUE
|
||||
DPARAM(1) = DFLAG
|
||||
RETURN
|
||||
END
|
||||
Reference in New Issue
Block a user