LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ check0()

subroutine check0 ( double precision  SFAC)

Definition at line 83 of file c_dblat1.f.

83 * .. Parameters ..
84  INTEGER nout
85  parameter(nout=6)
86 * .. Scalar Arguments ..
87  DOUBLE PRECISION sfac
88 * .. Scalars in Common ..
89  INTEGER icase, incx, incy, mode, n
90  LOGICAL pass
91 * .. Local Scalars ..
92  DOUBLE PRECISION sa, sb, sc, ss
93  INTEGER k
94 * .. Local Arrays ..
95  DOUBLE PRECISION da1(8), datrue(8), db1(8), dbtrue(8), dc1(8),
96  + ds1(8)
97 * .. External Subroutines ..
98  EXTERNAL drotgtest, stest1
99 * .. Common blocks ..
100  COMMON /combla/icase, n, incx, incy, mode, pass
101 * .. Data statements ..
102  DATA da1/0.3d0, 0.4d0, -0.3d0, -0.4d0, -0.3d0, 0.0d0,
103  + 0.0d0, 1.0d0/
104  DATA db1/0.4d0, 0.3d0, 0.4d0, 0.3d0, -0.4d0, 0.0d0,
105  + 1.0d0, 0.0d0/
106  DATA dc1/0.6d0, 0.8d0, -0.6d0, 0.8d0, 0.6d0, 1.0d0,
107  + 0.0d0, 1.0d0/
108  DATA ds1/0.8d0, 0.6d0, 0.8d0, -0.6d0, 0.8d0, 0.0d0,
109  + 1.0d0, 0.0d0/
110  DATA datrue/0.5d0, 0.5d0, 0.5d0, -0.5d0, -0.5d0,
111  + 0.0d0, 1.0d0, 1.0d0/
112  DATA dbtrue/0.0d0, 0.6d0, 0.0d0, -0.6d0, 0.0d0,
113  + 0.0d0, 1.0d0, 0.0d0/
114 * .. Executable Statements ..
115 *
116 * Compute true values which cannot be prestored
117 * in decimal notation
118 *
119  dbtrue(1) = 1.0d0/0.6d0
120  dbtrue(3) = -1.0d0/0.6d0
121  dbtrue(5) = 1.0d0/0.6d0
122 *
123  DO 20 k = 1, 8
124 * .. Set N=K for identification in output if any ..
125  n = k
126  IF (icase.EQ.3) THEN
127 * .. DROTGTEST ..
128  IF (k.GT.8) GO TO 40
129  sa = da1(k)
130  sb = db1(k)
131  CALL drotgtest(sa,sb,sc,ss)
132  CALL stest1(sa,datrue(k),datrue(k),sfac)
133  CALL stest1(sb,dbtrue(k),dbtrue(k),sfac)
134  CALL stest1(sc,dc1(k),dc1(k),sfac)
135  CALL stest1(ss,ds1(k),ds1(k),sfac)
136  ELSE
137  WRITE (nout,*) ' Shouldn''t be here in CHECK0'
138  stop
139  END IF
140  20 CONTINUE
141  40 RETURN
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:620
Here is the call graph for this function: