srotm.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 171 行
HTML
171 行
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>srotm.f</title>
<meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!--
body { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: none; }
span.default { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: none; }
span.default a { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: underline; }
span.comment { color: rgb(178, 34, 34); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: none; }
span.comment a { color: rgb(178, 34, 34); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: underline; }
--></style>
</head>
<body>
<pre>
SUBROUTINE <a name="SROTM.1"></a><a href="srotm.f.html#SROTM.1">SROTM</a>(N,SX,INCX,SY,INCY,SPARAM)
<span class="comment">*</span><span class="comment"> .. Scalar Arguments ..
</span> INTEGER INCX,INCY,N
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Array Arguments ..
</span> REAL SPARAM(5),SX(1),SY(1)
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Purpose
</span><span class="comment">*</span><span class="comment"> =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
</span><span class="comment">*</span><span class="comment"> (DX**T)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
</span><span class="comment">*</span><span class="comment"> LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
</span><span class="comment">*</span><span class="comment"> WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
</span><span class="comment">*</span><span class="comment"> H=( ) ( ) ( ) ( )
</span><span class="comment">*</span><span class="comment"> (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
</span><span class="comment">*</span><span class="comment"> SEE <a name="SROTMG.26"></a><a href="srotmg.f.html#SROTMG.1">SROTMG</a> FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Arguments
</span><span class="comment">*</span><span class="comment"> =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> N (input) INTEGER
</span><span class="comment">*</span><span class="comment"> number of elements in input vector(s)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> SX (input/output) REAL array, dimension N
</span><span class="comment">*</span><span class="comment"> double precision vector with 5 elements
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> INCX (input) INTEGER
</span><span class="comment">*</span><span class="comment"> storage spacing between elements of SX
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> SY (input/output) REAL array, dimension N
</span><span class="comment">*</span><span class="comment"> double precision vector with N elements
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> INCY (input) INTEGER
</span><span class="comment">*</span><span class="comment"> storage spacing between elements of SY
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> SPARAM (input/output) REAL array, dimension 5
</span><span class="comment">*</span><span class="comment"> SPARAM(1)=SFLAG
</span><span class="comment">*</span><span class="comment"> SPARAM(2)=SH11
</span><span class="comment">*</span><span class="comment"> SPARAM(3)=SH21
</span><span class="comment">*</span><span class="comment"> SPARAM(4)=SH12
</span><span class="comment">*</span><span class="comment"> SPARAM(5)=SH22
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> .. Local Scalars ..
</span> REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
INTEGER I,KX,KY,NSTEPS
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Data statements ..
</span> DATA ZERO,TWO/0.E0,2.E0/
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment">
</span> SFLAG = SPARAM(1)
IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) GO TO 140
IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70
<span class="comment">*</span><span class="comment">
</span> NSTEPS = N*INCX
IF (SFLAG) 50,10,30
10 CONTINUE
SH12 = SPARAM(4)
SH21 = SPARAM(3)
DO 20 I = 1,NSTEPS,INCX
W = SX(I)
Z = SY(I)
SX(I) = W + Z*SH12
SY(I) = W*SH21 + Z
20 CONTINUE
GO TO 140
30 CONTINUE
SH11 = SPARAM(2)
SH22 = SPARAM(5)
DO 40 I = 1,NSTEPS,INCX
W = SX(I)
Z = SY(I)
SX(I) = W*SH11 + Z
SY(I) = -W + SH22*Z
40 CONTINUE
GO TO 140
50 CONTINUE
SH11 = SPARAM(2)
SH12 = SPARAM(4)
SH21 = SPARAM(3)
SH22 = SPARAM(5)
DO 60 I = 1,NSTEPS,INCX
W = SX(I)
Z = SY(I)
SX(I) = W*SH11 + Z*SH12
SY(I) = W*SH21 + Z*SH22
60 CONTINUE
GO TO 140
70 CONTINUE
KX = 1
KY = 1
IF (INCX.LT.0) KX = 1 + (1-N)*INCX
IF (INCY.LT.0) KY = 1 + (1-N)*INCY
<span class="comment">*</span><span class="comment">
</span> IF (SFLAG) 120,80,100
80 CONTINUE
SH12 = SPARAM(4)
SH21 = SPARAM(3)
DO 90 I = 1,N
W = SX(KX)
Z = SY(KY)
SX(KX) = W + Z*SH12
SY(KY) = W*SH21 + Z
KX = KX + INCX
KY = KY + INCY
90 CONTINUE
GO TO 140
100 CONTINUE
SH11 = SPARAM(2)
SH22 = SPARAM(5)
DO 110 I = 1,N
W = SX(KX)
Z = SY(KY)
SX(KX) = W*SH11 + Z
SY(KY) = -W + SH22*Z
KX = KX + INCX
KY = KY + INCY
110 CONTINUE
GO TO 140
120 CONTINUE
SH11 = SPARAM(2)
SH12 = SPARAM(4)
SH21 = SPARAM(3)
SH22 = SPARAM(5)
DO 130 I = 1,N
W = SX(KX)
Z = SY(KY)
SX(KX) = W*SH11 + Z*SH12
SY(KY) = W*SH21 + Z*SH22
KX = KX + INCX
KY = KY + INCY
130 CONTINUE
140 CONTINUE
RETURN
END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?