OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
double
Reference BLAS » Level1

Functions

double precision function dasum (n, dx, incx)
 DASUM
subroutine daxpy (n, da, dx, incx, dy, incy)
 DAXPY
double precision function dcabs1 (z)
 DCABS1
subroutine dcopy (n, dx, incx, dy, incy)
 DCOPY
double precision function ddot (n, dx, incx, dy, incy)
 DDOT
subroutine drot (n, dx, incx, dy, incy, c, s)
 DROT
subroutine drotm (n, dx, incx, dy, incy, dparam)
 DROTM
subroutine drotmg (dd1, dd2, dx1, dy1, dparam)
 DROTMG
subroutine dscal (n, da, dx, incx)
 DSCAL
double precision function dsdot (n, sx, incx, sy, incy)
 DSDOT
subroutine dswap (n, dx, incx, dy, incy)
 DSWAP
subroutine dtrsv (uplo, trans, diag, n, a, lda, x, incx)
 DTRSV
double precision function dzasum (n, zx, incx)
 DZASUM

Detailed Description

This is the group of double LEVEL 1 BLAS routines.

Function Documentation

◆ dasum()

double precision function dasum ( integer n,
double precision, dimension(*) dx,
integer incx )

DASUM

Purpose:
!>
!>    DASUM takes the sum of the absolute values.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, linpack, 3/11/78.
!>     modified 3/93 to return if incx .le. 0.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 70 of file dasum.f.

71*
72* -- Reference BLAS level1 routine --
73* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
74* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
75*
76* .. Scalar Arguments ..
77 INTEGER INCX,N
78* ..
79* .. Array Arguments ..
80 DOUBLE PRECISION DX(*)
81* ..
82*
83* =====================================================================
84*
85* .. Local Scalars ..
86 DOUBLE PRECISION DTEMP
87 INTEGER I,M,MP1,NINCX
88* ..
89* .. Intrinsic Functions ..
90 INTRINSIC dabs,mod
91* ..
92 dasum = 0.0d0
93 dtemp = 0.0d0
94 IF (n.LE.0 .OR. incx.LE.0) RETURN
95 IF (incx.EQ.1) THEN
96* code for increment equal to 1
97*
98*
99* clean-up loop
100*
101 m = mod(n,6)
102 IF (m.NE.0) THEN
103 DO i = 1,m
104 dtemp = dtemp + dabs(dx(i))
105 END DO
106 IF (n.LT.6) THEN
107 dasum = dtemp
108 RETURN
109 END IF
110 END IF
111 mp1 = m + 1
112 DO i = mp1,n,6
113 dtemp = dtemp + dabs(dx(i)) + dabs(dx(i+1)) +
114 $ dabs(dx(i+2)) + dabs(dx(i+3)) +
115 $ dabs(dx(i+4)) + dabs(dx(i+5))
116 END DO
117 ELSE
118*
119* code for increment not equal to 1
120*
121 nincx = n*incx
122 DO i = 1,nincx,incx
123 dtemp = dtemp + dabs(dx(i))
124 END DO
125 END IF
126 dasum = dtemp
127 RETURN
128*
129* End of DASUM
130*
dasum
double precision function dasum(n, dx, incx)
DASUM
Definition dasum.f:71

◆ daxpy()

subroutine daxpy ( integer n,
double precision da,
double precision, dimension(*) dx,
integer incx,
double precision, dimension(*) dy,
integer incy )

DAXPY

Purpose:
!>
!>    DAXPY constant times a vector plus a vector.
!>    uses unrolled loops for increments equal to one.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in]DA
!>          DA is DOUBLE PRECISION
!>           On entry, DA specifies the scalar alpha.
!>
[in]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
[in,out]DY
!>          DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
!>
[in]INCY
!>          INCY is INTEGER
!>         storage spacing between elements of DY
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, linpack, 3/11/78.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 88 of file daxpy.f.

89*
90* -- Reference BLAS level1 routine --
91* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
92* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
93*
94* .. Scalar Arguments ..
95 DOUBLE PRECISION DA
96 INTEGER INCX,INCY,N
97* ..
98* .. Array Arguments ..
99 DOUBLE PRECISION DX(*),DY(*)
100* ..
101*
102* =====================================================================
103*
104* .. Local Scalars ..
105 INTEGER I,IX,IY,M,MP1
106* ..
107* .. Intrinsic Functions ..
108 INTRINSIC mod
109* ..
110 IF (n.LE.0) RETURN
111 IF (da.EQ.0.0d0) RETURN
112 IF (incx.EQ.1 .AND. incy.EQ.1) THEN
113*
114* code for both increments equal to 1
115*
116*
117* clean-up loop
118*
119 m = mod(n,4)
120 IF (m.NE.0) THEN
121 DO i = 1,m
122 dy(i) = dy(i) + da*dx(i)
123 END DO
124 END IF
125 IF (n.LT.4) RETURN
126 mp1 = m + 1
127 DO i = mp1,n,4
128 dy(i) = dy(i) + da*dx(i)
129 dy(i+1) = dy(i+1) + da*dx(i+1)
130 dy(i+2) = dy(i+2) + da*dx(i+2)
131 dy(i+3) = dy(i+3) + da*dx(i+3)
132 END DO
133 ELSE
134*
135* code for unequal increments or equal increments
136* not equal to 1
137*
138 ix = 1
139 iy = 1
140 IF (incx.LT.0) ix = (-n+1)*incx + 1
141 IF (incy.LT.0) iy = (-n+1)*incy + 1
142 DO i = 1,n
143 dy(iy) = dy(iy) + da*dx(ix)
144 ix = ix + incx
145 iy = iy + incy
146 END DO
147 END IF
148 RETURN
149*
150* End of DAXPY
151*

◆ dcabs1()

double precision function dcabs1 ( complex*16 z)

DCABS1

Purpose:
!>
!> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number
!>
Parameters
[in]Z
!>          Z is COMPLEX*16
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 46 of file dcabs1.f.

47*
48* -- Reference BLAS level1 routine --
49* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
50* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
51*
52* .. Scalar Arguments ..
53 COMPLEX*16 Z
54* ..
55* ..
56* =====================================================================
57*
58* .. Intrinsic Functions ..
59 INTRINSIC abs,dble,dimag
60*
61 dcabs1 = abs(dble(z)) + abs(dimag(z))
62 RETURN
63*
64* End of DCABS1
65*
dcabs1
double precision function dcabs1(z)
DCABS1
Definition dcabs1.f:47

◆ dcopy()

subroutine dcopy ( integer n,
double precision, dimension(*) dx,
integer incx,
double precision, dimension(*) dy,
integer incy )

DCOPY

Purpose:
!>
!>    DCOPY copies a vector, x, to a vector, y.
!>    uses unrolled loops for increments equal to 1.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
[out]DY
!>          DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
!>
[in]INCY
!>          INCY is INTEGER
!>         storage spacing between elements of DY
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, linpack, 3/11/78.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 81 of file dcopy.f.

82*
83* -- Reference BLAS level1 routine --
84* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
85* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
86*
87* .. Scalar Arguments ..
88 INTEGER INCX,INCY,N
89* ..
90* .. Array Arguments ..
91 DOUBLE PRECISION DX(*),DY(*)
92* ..
93*
94* =====================================================================
95*
96* .. Local Scalars ..
97 INTEGER I,IX,IY,M,MP1
98* ..
99* .. Intrinsic Functions ..
100 INTRINSIC mod
101* ..
102 IF (n.LE.0) RETURN
103 IF (incx.EQ.1 .AND. incy.EQ.1) THEN
104*
105* code for both increments equal to 1
106*
107*
108* clean-up loop
109*
110 m = mod(n,7)
111 IF (m.NE.0) THEN
112 DO i = 1,m
113 dy(i) = dx(i)
114 END DO
115 IF (n.LT.7) RETURN
116 END IF
117 mp1 = m + 1
118 DO i = mp1,n,7
119 dy(i) = dx(i)
120 dy(i+1) = dx(i+1)
121 dy(i+2) = dx(i+2)
122 dy(i+3) = dx(i+3)
123 dy(i+4) = dx(i+4)
124 dy(i+5) = dx(i+5)
125 dy(i+6) = dx(i+6)
126 END DO
127 ELSE
128*
129* code for unequal increments or equal increments
130* not equal to 1
131*
132 ix = 1
133 iy = 1
134 IF (incx.LT.0) ix = (-n+1)*incx + 1
135 IF (incy.LT.0) iy = (-n+1)*incy + 1
136 DO i = 1,n
137 dy(iy) = dx(ix)
138 ix = ix + incx
139 iy = iy + incy
140 END DO
141 END IF
142 RETURN
143*
144* End of DCOPY
145*

◆ ddot()

double precision function ddot ( integer n,
double precision, dimension(*) dx,
integer incx,
double precision, dimension(*) dy,
integer incy )

DDOT

Purpose:
!>
!>    DDOT forms the dot product of two vectors.
!>    uses unrolled loops for increments equal to one.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
[in]DY
!>          DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
!>
[in]INCY
!>          INCY is INTEGER
!>         storage spacing between elements of DY
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, linpack, 3/11/78.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 81 of file ddot.f.

82*
83* -- Reference BLAS level1 routine --
84* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
85* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
86*
87* .. Scalar Arguments ..
88 INTEGER INCX,INCY,N
89* ..
90* .. Array Arguments ..
91 DOUBLE PRECISION DX(*),DY(*)
92* ..
93*
94* =====================================================================
95*
96* .. Local Scalars ..
97 DOUBLE PRECISION DTEMP
98 INTEGER I,IX,IY,M,MP1
99* ..
100* .. Intrinsic Functions ..
101 INTRINSIC mod
102* ..
103 ddot = 0.0d0
104 dtemp = 0.0d0
105 IF (n.LE.0) RETURN
106 IF (incx.EQ.1 .AND. incy.EQ.1) THEN
107*
108* code for both increments equal to 1
109*
110*
111* clean-up loop
112*
113 m = mod(n,5)
114 IF (m.NE.0) THEN
115 DO i = 1,m
116 dtemp = dtemp + dx(i)*dy(i)
117 END DO
118 IF (n.LT.5) THEN
119 ddot=dtemp
120 RETURN
121 END IF
122 END IF
123 mp1 = m + 1
124 DO i = mp1,n,5
125 dtemp = dtemp + dx(i)*dy(i) + dx(i+1)*dy(i+1) +
126 $ dx(i+2)*dy(i+2) + dx(i+3)*dy(i+3) + dx(i+4)*dy(i+4)
127 END DO
128 ELSE
129*
130* code for unequal increments or equal increments
131* not equal to 1
132*
133 ix = 1
134 iy = 1
135 IF (incx.LT.0) ix = (-n+1)*incx + 1
136 IF (incy.LT.0) iy = (-n+1)*incy + 1
137 DO i = 1,n
138 dtemp = dtemp + dx(ix)*dy(iy)
139 ix = ix + incx
140 iy = iy + incy
141 END DO
142 END IF
143 ddot = dtemp
144 RETURN
145*
146* End of DDOT
147*
ddot
double precision function ddot(n, dx, incx, dy, incy)
DDOT
Definition ddot.f:82

◆ drot()

subroutine drot ( integer n,
double precision, dimension(*) dx,
integer incx,
double precision, dimension(*) dy,
integer incy,
double precision c,
double precision s )

DROT

Purpose:
!>
!>    DROT applies a plane rotation.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in,out]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
[in,out]DY
!>          DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
!>
[in]INCY
!>          INCY is INTEGER
!>         storage spacing between elements of DY
!>
[in]C
!>          C is DOUBLE PRECISION
!>
[in]S
!>          S is DOUBLE PRECISION
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, linpack, 3/11/78.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 91 of file drot.f.

92*
93* -- Reference BLAS level1 routine --
94* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
95* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
96*
97* .. Scalar Arguments ..
98 DOUBLE PRECISION C,S
99 INTEGER INCX,INCY,N
100* ..
101* .. Array Arguments ..
102 DOUBLE PRECISION DX(*),DY(*)
103* ..
104*
105* =====================================================================
106*
107* .. Local Scalars ..
108 DOUBLE PRECISION DTEMP
109 INTEGER I,IX,IY
110* ..
111 IF (n.LE.0) RETURN
112 IF (incx.EQ.1 .AND. incy.EQ.1) THEN
113*
114* code for both increments equal to 1
115*
116 DO i = 1,n
117 dtemp = c*dx(i) + s*dy(i)
118 dy(i) = c*dy(i) - s*dx(i)
119 dx(i) = dtemp
120 END DO
121 ELSE
122*
123* code for unequal increments or equal increments not equal
124* to 1
125*
126 ix = 1
127 iy = 1
128 IF (incx.LT.0) ix = (-n+1)*incx + 1
129 IF (incy.LT.0) iy = (-n+1)*incy + 1
130 DO i = 1,n
131 dtemp = c*dx(ix) + s*dy(iy)
132 dy(iy) = c*dy(iy) - s*dx(ix)
133 dx(ix) = dtemp
134 ix = ix + incx
135 iy = iy + incy
136 END DO
137 END IF
138 RETURN
139*
140* End of DROT
141*

◆ drotm()

subroutine drotm ( integer n,
double precision, dimension(*) dx,
integer incx,
double precision, dimension(*) dy,
integer incy,
double precision, dimension(5) dparam )

DROTM

Purpose:
!>
!>    APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
!>
!>    (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
!>    (DY**T)
!>
!>    DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
!>    LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
!>    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).
!>    SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in,out]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
[in,out]DY
!>          DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
!>
[in]INCY
!>          INCY is INTEGER
!>         storage spacing between elements of DY
!>
[in]DPARAM
!>          DPARAM is DOUBLE PRECISION array, dimension (5)
!>     DPARAM(1)=DFLAG
!>     DPARAM(2)=DH11
!>     DPARAM(3)=DH21
!>     DPARAM(4)=DH12
!>     DPARAM(5)=DH22
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 95 of file drotm.f.

96*
97* -- Reference BLAS level1 routine --
98* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
99* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
100*
101* .. Scalar Arguments ..
102 INTEGER INCX,INCY,N
103* ..
104* .. Array Arguments ..
105 DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
106* ..
107*
108* =====================================================================
109*
110* .. Local Scalars ..
111 DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
112 INTEGER I,KX,KY,NSTEPS
113* ..
114* .. Data statements ..
115 DATA zero,two/0.d0,2.d0/
116* ..
117*
118 dflag = dparam(1)
119 IF (n.LE.0 .OR. (dflag+two.EQ.zero)) RETURN
120 IF (incx.EQ.incy.AND.incx.GT.0) THEN
121*
122 nsteps = n*incx
123 IF (dflag.LT.zero) THEN
124 dh11 = dparam(2)
125 dh12 = dparam(4)
126 dh21 = dparam(3)
127 dh22 = dparam(5)
128 DO i = 1,nsteps,incx
129 w = dx(i)
130 z = dy(i)
131 dx(i) = w*dh11 + z*dh12
132 dy(i) = w*dh21 + z*dh22
133 END DO
134 ELSE IF (dflag.EQ.zero) THEN
135 dh12 = dparam(4)
136 dh21 = dparam(3)
137 DO i = 1,nsteps,incx
138 w = dx(i)
139 z = dy(i)
140 dx(i) = w + z*dh12
141 dy(i) = w*dh21 + z
142 END DO
143 ELSE
144 dh11 = dparam(2)
145 dh22 = dparam(5)
146 DO i = 1,nsteps,incx
147 w = dx(i)
148 z = dy(i)
149 dx(i) = w*dh11 + z
150 dy(i) = -w + dh22*z
151 END DO
152 END IF
153 ELSE
154 kx = 1
155 ky = 1
156 IF (incx.LT.0) kx = 1 + (1-n)*incx
157 IF (incy.LT.0) ky = 1 + (1-n)*incy
158*
159 IF (dflag.LT.zero) THEN
160 dh11 = dparam(2)
161 dh12 = dparam(4)
162 dh21 = dparam(3)
163 dh22 = dparam(5)
164 DO i = 1,n
165 w = dx(kx)
166 z = dy(ky)
167 dx(kx) = w*dh11 + z*dh12
168 dy(ky) = w*dh21 + z*dh22
169 kx = kx + incx
170 ky = ky + incy
171 END DO
172 ELSE IF (dflag.EQ.zero) THEN
173 dh12 = dparam(4)
174 dh21 = dparam(3)
175 DO i = 1,n
176 w = dx(kx)
177 z = dy(ky)
178 dx(kx) = w + z*dh12
179 dy(ky) = w*dh21 + z
180 kx = kx + incx
181 ky = ky + incy
182 END DO
183 ELSE
184 dh11 = dparam(2)
185 dh22 = dparam(5)
186 DO i = 1,n
187 w = dx(kx)
188 z = dy(ky)
189 dx(kx) = w*dh11 + z
190 dy(ky) = -w + dh22*z
191 kx = kx + incx
192 ky = ky + incy
193 END DO
194 END IF
195 END IF
196 RETURN
197*
198* End of DROTM
199*

◆ drotmg()

subroutine drotmg ( double precision dd1,
double precision dd2,
double precision dx1,
double precision dy1,
double precision, dimension(5) dparam )

DROTMG

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.
!>
!>
Parameters
[in,out]DD1
!>          DD1 is DOUBLE PRECISION
!>
[in,out]DD2
!>          DD2 is DOUBLE PRECISION
!>
[in,out]DX1
!>          DX1 is DOUBLE PRECISION
!>
[in]DY1
!>          DY1 is DOUBLE PRECISION
!>
[out]DPARAM
!>          DPARAM is DOUBLE PRECISION array, dimension (5)
!>     DPARAM(1)=DFLAG
!>     DPARAM(2)=DH11
!>     DPARAM(3)=DH21
!>     DPARAM(4)=DH12
!>     DPARAM(5)=DH22
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 89 of file drotmg.f.

90*
91* -- Reference BLAS level1 routine --
92* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
93* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94*
95* .. Scalar Arguments ..
96 DOUBLE PRECISION DD1,DD2,DX1,DY1
97* ..
98* .. Array Arguments ..
99 DOUBLE PRECISION DPARAM(5)
100* ..
101*
102* =====================================================================
103*
104* .. Local Scalars ..
105 DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,DP1,DP2,DQ1,DQ2,DTEMP,
106 $ DU,GAM,GAMSQ,ONE,RGAMSQ,TWO,ZERO
107* ..
108* .. Intrinsic Functions ..
109 INTRINSIC dabs
110* ..
111* .. Data statements ..
112*
113 DATA zero,one,two/0.d0,1.d0,2.d0/
114 DATA gam,gamsq,rgamsq/4096.d0,16777216.d0,5.9604645d-8/
115* ..
116
117 IF (dd1.LT.zero) THEN
118* GO ZERO-H-D-AND-DX1..
119 dflag = -one
120 dh11 = zero
121 dh12 = zero
122 dh21 = zero
123 dh22 = zero
124*
125 dd1 = zero
126 dd2 = zero
127 dx1 = zero
128 ELSE
129* CASE-DD1-NONNEGATIVE
130 dp2 = dd2*dy1
131 IF (dp2.EQ.zero) THEN
132 dflag = -two
133 dparam(1) = dflag
134 RETURN
135 END IF
136* REGULAR-CASE..
137 dp1 = dd1*dx1
138 dq2 = dp2*dy1
139 dq1 = dp1*dx1
140*
141 IF (dabs(dq1).GT.dabs(dq2)) THEN
142 dh21 = -dy1/dx1
143 dh12 = dp2/dp1
144*
145 du = one - dh12*dh21
146*
147 IF (du.GT.zero) THEN
148 dflag = zero
149 dd1 = dd1/du
150 dd2 = dd2/du
151 dx1 = dx1*du
152 ELSE
153* This code path if here for safety. We do not expect this
154* condition to ever hold except in edge cases with rounding
155* errors. See DOI: 10.1145/355841.355847
156 dflag = -one
157 dh11 = zero
158 dh12 = zero
159 dh21 = zero
160 dh22 = zero
161*
162 dd1 = zero
163 dd2 = zero
164 dx1 = zero
165 END IF
166 ELSE
167
168 IF (dq2.LT.zero) THEN
169* GO ZERO-H-D-AND-DX1..
170 dflag = -one
171 dh11 = zero
172 dh12 = zero
173 dh21 = zero
174 dh22 = zero
175*
176 dd1 = zero
177 dd2 = zero
178 dx1 = zero
179 ELSE
180 dflag = one
181 dh11 = dp1/dp2
182 dh22 = dx1/dy1
183 du = one + dh11*dh22
184 dtemp = dd2/du
185 dd2 = dd1/du
186 dd1 = dtemp
187 dx1 = dy1*du
188 END IF
189 END IF
190
191* PROCEDURE..SCALE-CHECK
192 IF (dd1.NE.zero) THEN
193 DO WHILE ((dd1.LE.rgamsq) .OR. (dd1.GE.gamsq))
194 IF (dflag.EQ.zero) THEN
195 dh11 = one
196 dh22 = one
197 dflag = -one
198 ELSE
199 dh21 = -one
200 dh12 = one
201 dflag = -one
202 END IF
203 IF (dd1.LE.rgamsq) THEN
204 dd1 = dd1*gam**2
205 dx1 = dx1/gam
206 dh11 = dh11/gam
207 dh12 = dh12/gam
208 ELSE
209 dd1 = dd1/gam**2
210 dx1 = dx1*gam
211 dh11 = dh11*gam
212 dh12 = dh12*gam
213 END IF
214 ENDDO
215 END IF
216
217 IF (dd2.NE.zero) THEN
218 DO WHILE ( (dabs(dd2).LE.rgamsq) .OR. (dabs(dd2).GE.gamsq) )
219 IF (dflag.EQ.zero) THEN
220 dh11 = one
221 dh22 = one
222 dflag = -one
223 ELSE
224 dh21 = -one
225 dh12 = one
226 dflag = -one
227 END IF
228 IF (dabs(dd2).LE.rgamsq) THEN
229 dd2 = dd2*gam**2
230 dh21 = dh21/gam
231 dh22 = dh22/gam
232 ELSE
233 dd2 = dd2/gam**2
234 dh21 = dh21*gam
235 dh22 = dh22*gam
236 END IF
237 END DO
238 END IF
239
240 END IF
241
242 IF (dflag.LT.zero) THEN
243 dparam(2) = dh11
244 dparam(3) = dh21
245 dparam(4) = dh12
246 dparam(5) = dh22
247 ELSE IF (dflag.EQ.zero) THEN
248 dparam(3) = dh21
249 dparam(4) = dh12
250 ELSE
251 dparam(2) = dh11
252 dparam(5) = dh22
253 END IF
254
255 dparam(1) = dflag
256 RETURN
257*
258* End of DROTMG
259*

◆ dscal()

subroutine dscal ( integer n,
double precision da,
double precision, dimension(*) dx,
integer incx )

DSCAL

Purpose:
!>
!>    DSCAL scales a vector by a constant.
!>    uses unrolled loops for increment equal to 1.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in]DA
!>          DA is DOUBLE PRECISION
!>           On entry, DA specifies the scalar alpha.
!>
[in,out]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, linpack, 3/11/78.
!>     modified 3/93 to return if incx .le. 0.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 78 of file dscal.f.

79*
80* -- Reference BLAS level1 routine --
81* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
82* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
83*
84* .. Scalar Arguments ..
85 DOUBLE PRECISION DA
86 INTEGER INCX,N
87* ..
88* .. Array Arguments ..
89 DOUBLE PRECISION DX(*)
90* ..
91*
92* =====================================================================
93*
94* .. Local Scalars ..
95 INTEGER I,M,MP1,NINCX
96* ..
97* .. Intrinsic Functions ..
98 INTRINSIC mod
99* ..
100 IF (n.LE.0 .OR. incx.LE.0) RETURN
101 IF (incx.EQ.1) THEN
102*
103* code for increment equal to 1
104*
105*
106* clean-up loop
107*
108 m = mod(n,5)
109 IF (m.NE.0) THEN
110 DO i = 1,m
111 dx(i) = da*dx(i)
112 END DO
113 IF (n.LT.5) RETURN
114 END IF
115 mp1 = m + 1
116 DO i = mp1,n,5
117 dx(i) = da*dx(i)
118 dx(i+1) = da*dx(i+1)
119 dx(i+2) = da*dx(i+2)
120 dx(i+3) = da*dx(i+3)
121 dx(i+4) = da*dx(i+4)
122 END DO
123 ELSE
124*
125* code for increment not equal to 1
126*
127 nincx = n*incx
128 DO i = 1,nincx,incx
129 dx(i) = da*dx(i)
130 END DO
131 END IF
132 RETURN
133*
134* End of DSCAL
135*

◆ dsdot()

double precision function dsdot ( integer n,
real, dimension(*) sx,
integer incx,
real, dimension(*) sy,
integer incy )

DSDOT

Purpose:
!>
!> Compute the inner product of two vectors with extended
!> precision accumulation and result.
!>
!> Returns D.P. dot product accumulated in D.P., for S.P. SX and SY
!> DSDOT = sum for I = 0 to N-1 of  SX(LX+I*INCX) * SY(LY+I*INCY),
!> where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
!> defined in a similar way using INCY.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in]SX
!>          SX is REAL array, dimension(N)
!>         single precision vector with N elements
!>
[in]INCX
!>          INCX is INTEGER
!>          storage spacing between elements of SX
!>
[in]SY
!>          SY is REAL array, dimension(N)
!>         single precision vector with N elements
!>
[in]INCY
!>          INCY is INTEGER
!>         storage spacing between elements of SY
!>
Returns
DSDOT 
!>          DSDOT is DOUBLE PRECISION
!>         DSDOT  double precision dot product (zero if N.LE.0)
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
References:
!>
!>
!>  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
!>  Krogh, Basic linear algebra subprograms for Fortran
!>  usage, Algorithm No. 539, Transactions on Mathematical
!>  Software 5, 3 (September 1979), pp. 308-323.
!>
!>  REVISION HISTORY  (YYMMDD)
!>
!>  791001  DATE WRITTEN
!>  890831  Modified array declarations.  (WRB)
!>  890831  REVISION DATE from Version 3.2
!>  891214  Prologue converted to Version 4.0 format.  (BAB)
!>  920310  Corrected definition of LX in DESCRIPTION.  (WRB)
!>  920501  Reformatted the REFERENCES section.  (WRB)
!>  070118  Reformat to LAPACK style (JL)
!>

Definition at line 118 of file dsdot.f.

119*
120* -- Reference BLAS level1 routine --
121* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
122* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
123*
124* .. Scalar Arguments ..
125 INTEGER INCX,INCY,N
126* ..
127* .. Array Arguments ..
128 REAL SX(*),SY(*)
129* ..
130*
131* Authors:
132* ========
133* Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
134* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
135*
136* =====================================================================
137*
138* .. Local Scalars ..
139 INTEGER I,KX,KY,NS
140* ..
141* .. Intrinsic Functions ..
142 INTRINSIC dble
143* ..
144 dsdot = 0.0d0
145 IF (n.LE.0) RETURN
146 IF (incx.EQ.incy .AND. incx.GT.0) THEN
147*
148* Code for equal, positive, non-unit increments.
149*
150 ns = n*incx
151 DO i = 1,ns,incx
152 dsdot = dsdot + dble(sx(i))*dble(sy(i))
153 END DO
154 ELSE
155*
156* Code for unequal or nonpositive increments.
157*
158 kx = 1
159 ky = 1
160 IF (incx.LT.0) kx = 1 + (1-n)*incx
161 IF (incy.LT.0) ky = 1 + (1-n)*incy
162 DO i = 1,n
163 dsdot = dsdot + dble(sx(kx))*dble(sy(ky))
164 kx = kx + incx
165 ky = ky + incy
166 END DO
167 END IF
168 RETURN
169*
170* End of DSDOT
171*
dsdot
double precision function dsdot(n, sx, incx, sy, incy)
DSDOT
Definition dsdot.f:119

◆ dswap()

subroutine dswap ( integer n,
double precision, dimension(*) dx,
integer incx,
double precision, dimension(*) dy,
integer incy )

DSWAP

Purpose:
!>
!>    DSWAP interchanges two vectors.
!>    uses unrolled loops for increments equal to 1.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in,out]DX
!>          DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of DX
!>
[in,out]DY
!>          DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
!>
[in]INCY
!>          INCY is INTEGER
!>         storage spacing between elements of DY
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, linpack, 3/11/78.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 81 of file dswap.f.

82*
83* -- Reference BLAS level1 routine --
84* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
85* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
86*
87* .. Scalar Arguments ..
88 INTEGER INCX,INCY,N
89* ..
90* .. Array Arguments ..
91 DOUBLE PRECISION DX(*),DY(*)
92* ..
93*
94* =====================================================================
95*
96* .. Local Scalars ..
97 DOUBLE PRECISION DTEMP
98 INTEGER I,IX,IY,M,MP1
99* ..
100* .. Intrinsic Functions ..
101 INTRINSIC mod
102* ..
103 IF (n.LE.0) RETURN
104 IF (incx.EQ.1 .AND. incy.EQ.1) THEN
105*
106* code for both increments equal to 1
107*
108*
109* clean-up loop
110*
111 m = mod(n,3)
112 IF (m.NE.0) THEN
113 DO i = 1,m
114 dtemp = dx(i)
115 dx(i) = dy(i)
116 dy(i) = dtemp
117 END DO
118 IF (n.LT.3) RETURN
119 END IF
120 mp1 = m + 1
121 DO i = mp1,n,3
122 dtemp = dx(i)
123 dx(i) = dy(i)
124 dy(i) = dtemp
125 dtemp = dx(i+1)
126 dx(i+1) = dy(i+1)
127 dy(i+1) = dtemp
128 dtemp = dx(i+2)
129 dx(i+2) = dy(i+2)
130 dy(i+2) = dtemp
131 END DO
132 ELSE
133*
134* code for unequal increments or equal increments not equal
135* to 1
136*
137 ix = 1
138 iy = 1
139 IF (incx.LT.0) ix = (-n+1)*incx + 1
140 IF (incy.LT.0) iy = (-n+1)*incy + 1
141 DO i = 1,n
142 dtemp = dx(ix)
143 dx(ix) = dy(iy)
144 dy(iy) = dtemp
145 ix = ix + incx
146 iy = iy + incy
147 END DO
148 END IF
149 RETURN
150*
151* End of DSWAP
152*

◆ dtrsv()

subroutine dtrsv ( character uplo,
character trans,
character diag,
integer n,
double precision, dimension(lda,*) a,
integer lda,
double precision, dimension(*) x,
integer incx )

DTRSV

Purpose:
!>
!> DTRSV  solves one of the systems of equations
!>
!>    A*x = b,   or   A**T*x = b,
!>
!> where b and x are n element vectors and A is an n by n unit, or
!> non-unit, upper or lower triangular matrix.
!>
!> No test for singularity or near-singularity is included in this
!> routine. Such tests must be performed before calling this routine.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the matrix is an upper or
!>           lower triangular matrix as follows:
!>
!>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
!>
!>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the equations to be solved as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   A*x = b.
!>
!>              TRANS = 'T' or 't'   A**T*x = b.
!>
!>              TRANS = 'C' or 'c'   A**T*x = b.
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>           On entry, DIAG specifies whether or not A is unit
!>           triangular as follows:
!>
!>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
!>
!>              DIAG = 'N' or 'n'   A is not assumed to be unit
!>                                  triangular.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]A
!>          A is DOUBLE PRECISION array, dimension ( LDA, N )
!>           Before entry with  UPLO = 'U' or 'u', the leading n by n
!>           upper triangular part of the array A must contain the upper
!>           triangular matrix and the strictly lower triangular part of
!>           A is not referenced.
!>           Before entry with UPLO = 'L' or 'l', the leading n by n
!>           lower triangular part of the array A must contain the lower
!>           triangular matrix and the strictly upper triangular part of
!>           A is not referenced.
!>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
!>           A are not referenced either, but are assumed to be unity.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, n ).
!>
[in,out]X
!>          X is DOUBLE PRECISION array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element right-hand side vector b. On exit, X is overwritten
!>           with the solution vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 142 of file dtrsv.f.

143*
144* -- Reference BLAS level1 routine --
145* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
146* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
147*
148* .. Scalar Arguments ..
149 INTEGER INCX,LDA,N
150 CHARACTER DIAG,TRANS,UPLO
151* ..
152* .. Array Arguments ..
153 DOUBLE PRECISION A(LDA,*),X(*)
154* ..
155*
156* =====================================================================
157*
158* .. Parameters ..
159 DOUBLE PRECISION ZERO
160 parameter(zero=0.0d+0)
161* ..
162* .. Local Scalars ..
163 DOUBLE PRECISION TEMP
164 INTEGER I,INFO,IX,J,JX,KX
165 LOGICAL NOUNIT
166* ..
167* .. External Functions ..
168 LOGICAL LSAME
169 EXTERNAL lsame
170* ..
171* .. External Subroutines ..
172 EXTERNAL xerbla
173* ..
174* .. Intrinsic Functions ..
175 INTRINSIC max
176* ..
177*
178* Test the input parameters.
179*
180 info = 0
181 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
182 info = 1
183 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
184 + .NOT.lsame(trans,'C')) THEN
185 info = 2
186 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
187 info = 3
188 ELSE IF (n.LT.0) THEN
189 info = 4
190 ELSE IF (lda.LT.max(1,n)) THEN
191 info = 6
192 ELSE IF (incx.EQ.0) THEN
193 info = 8
194 END IF
195 IF (info.NE.0) THEN
196 CALL xerbla('DTRSV ',info)
197 RETURN
198 END IF
199*
200* Quick return if possible.
201*
202 IF (n.EQ.0) RETURN
203*
204 nounit = lsame(diag,'N')
205*
206* Set up the start point in X if the increment is not unity. This
207* will be ( N - 1 )*INCX too small for descending loops.
208*
209 IF (incx.LE.0) THEN
210 kx = 1 - (n-1)*incx
211 ELSE IF (incx.NE.1) THEN
212 kx = 1
213 END IF
214*
215* Start the operations. In this version the elements of A are
216* accessed sequentially with one pass through A.
217*
218 IF (lsame(trans,'N')) THEN
219*
220* Form x := inv( A )*x.
221*
222 IF (lsame(uplo,'U')) THEN
223 IF (incx.EQ.1) THEN
224 DO 20 j = n,1,-1
225 IF (x(j).NE.zero) THEN
226 IF (nounit) x(j) = x(j)/a(j,j)
227 temp = x(j)
228 DO 10 i = j - 1,1,-1
229 x(i) = x(i) - temp*a(i,j)
230 10 CONTINUE
231 END IF
232 20 CONTINUE
233 ELSE
234 jx = kx + (n-1)*incx
235 DO 40 j = n,1,-1
236 IF (x(jx).NE.zero) THEN
237 IF (nounit) x(jx) = x(jx)/a(j,j)
238 temp = x(jx)
239 ix = jx
240 DO 30 i = j - 1,1,-1
241 ix = ix - incx
242 x(ix) = x(ix) - temp*a(i,j)
243 30 CONTINUE
244 END IF
245 jx = jx - incx
246 40 CONTINUE
247 END IF
248 ELSE
249 IF (incx.EQ.1) THEN
250 DO 60 j = 1,n
251 IF (x(j).NE.zero) THEN
252 IF (nounit) x(j) = x(j)/a(j,j)
253 temp = x(j)
254 DO 50 i = j + 1,n
255 x(i) = x(i) - temp*a(i,j)
256 50 CONTINUE
257 END IF
258 60 CONTINUE
259 ELSE
260 jx = kx
261 DO 80 j = 1,n
262 IF (x(jx).NE.zero) THEN
263 IF (nounit) x(jx) = x(jx)/a(j,j)
264 temp = x(jx)
265 ix = jx
266 DO 70 i = j + 1,n
267 ix = ix + incx
268 x(ix) = x(ix) - temp*a(i,j)
269 70 CONTINUE
270 END IF
271 jx = jx + incx
272 80 CONTINUE
273 END IF
274 END IF
275 ELSE
276*
277* Form x := inv( A**T )*x.
278*
279 IF (lsame(uplo,'U')) THEN
280 IF (incx.EQ.1) THEN
281 DO 100 j = 1,n
282 temp = x(j)
283 DO 90 i = 1,j - 1
284 temp = temp - a(i,j)*x(i)
285 90 CONTINUE
286 IF (nounit) temp = temp/a(j,j)
287 x(j) = temp
288 100 CONTINUE
289 ELSE
290 jx = kx
291 DO 120 j = 1,n
292 temp = x(jx)
293 ix = kx
294 DO 110 i = 1,j - 1
295 temp = temp - a(i,j)*x(ix)
296 ix = ix + incx
297 110 CONTINUE
298 IF (nounit) temp = temp/a(j,j)
299 x(jx) = temp
300 jx = jx + incx
301 120 CONTINUE
302 END IF
303 ELSE
304 IF (incx.EQ.1) THEN
305 DO 140 j = n,1,-1
306 temp = x(j)
307 DO 130 i = n,j + 1,-1
308 temp = temp - a(i,j)*x(i)
309 130 CONTINUE
310 IF (nounit) temp = temp/a(j,j)
311 x(j) = temp
312 140 CONTINUE
313 ELSE
314 kx = kx + (n-1)*incx
315 jx = kx
316 DO 160 j = n,1,-1
317 temp = x(jx)
318 ix = kx
319 DO 150 i = n,j + 1,-1
320 temp = temp - a(i,j)*x(ix)
321 ix = ix - incx
322 150 CONTINUE
323 IF (nounit) temp = temp/a(j,j)
324 x(jx) = temp
325 jx = jx - incx
326 160 CONTINUE
327 END IF
328 END IF
329 END IF
330*
331 RETURN
332*
333* End of DTRSV
334*
xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
max
#define max(a, b)
Definition macros.h:21

◆ dzasum()

double precision function dzasum ( integer n,
complex*16, dimension(*) zx,
integer incx )

DZASUM

Purpose:
!>
!>    DZASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and
!>    returns a double precision result.
!>
Parameters
[in]N
!>          N is INTEGER
!>         number of elements in input vector(s)
!>
[in,out]ZX
!>          ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
!>
[in]INCX
!>          INCX is INTEGER
!>         storage spacing between elements of ZX
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>     jack dongarra, 3/11/78.
!>     modified 3/93 to return if incx .le. 0.
!>     modified 12/3/93, array(1) declarations changed to array(*)
!>

Definition at line 71 of file dzasum.f.

72*
73* -- Reference BLAS level1 routine --
74* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
75* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
76*
77* .. Scalar Arguments ..
78 INTEGER INCX,N
79* ..
80* .. Array Arguments ..
81 COMPLEX*16 ZX(*)
82* ..
83*
84* =====================================================================
85*
86* .. Local Scalars ..
87 DOUBLE PRECISION STEMP
88 INTEGER I,NINCX
89* ..
90* .. External Functions ..
91 DOUBLE PRECISION DCABS1
92 EXTERNAL dcabs1
93* ..
94 dzasum = 0.0d0
95 stemp = 0.0d0
96 IF (n.LE.0 .OR. incx.LE.0) RETURN
97 IF (incx.EQ.1) THEN
98*
99* code for increment equal to 1
100*
101 DO i = 1,n
102 stemp = stemp + dcabs1(zx(i))
103 END DO
104 ELSE
105*
106* code for increment not equal to 1
107*
108 nincx = n*incx
109 DO i = 1,nincx,incx
110 stemp = stemp + dcabs1(zx(i))
111 END DO
112 END IF
113 dzasum = stemp
114 RETURN
115*
116* End of DZASUM
117*
dzasum
double precision function dzasum(n, zx, incx)
DZASUM
Definition dzasum.f:72