LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine check0 ( real  SFAC)

Definition at line 83 of file c_sblat1.f.

83 * .. Parameters ..
84  INTEGER nout
85  parameter (nout=6)
86 * .. Scalar Arguments ..
87  REAL sfac
88 * .. Scalars in Common ..
89  INTEGER icase, incx, incy, mode, n
90  LOGICAL pass
91 * .. Local Scalars ..
92  REAL sa, sb, sc, ss
93  INTEGER k
94 * .. Local Arrays ..
95  REAL da1(8), datrue(8), db1(8), dbtrue(8), dc1(8),
96  + ds1(8)
97 * .. External Subroutines ..
98  EXTERNAL srotgtest, stest1
99 * .. Common blocks ..
100  COMMON /combla/icase, n, incx, incy, mode, pass
101 * .. Data statements ..
102  DATA da1/0.3e0, 0.4e0, -0.3e0, -0.4e0, -0.3e0, 0.0e0,
103  + 0.0e0, 1.0e0/
104  DATA db1/0.4e0, 0.3e0, 0.4e0, 0.3e0, -0.4e0, 0.0e0,
105  + 1.0e0, 0.0e0/
106  DATA dc1/0.6e0, 0.8e0, -0.6e0, 0.8e0, 0.6e0, 1.0e0,
107  + 0.0e0, 1.0e0/
108  DATA ds1/0.8e0, 0.6e0, 0.8e0, -0.6e0, 0.8e0, 0.0e0,
109  + 1.0e0, 0.0e0/
110  DATA datrue/0.5e0, 0.5e0, 0.5e0, -0.5e0, -0.5e0,
111  + 0.0e0, 1.0e0, 1.0e0/
112  DATA dbtrue/0.0e0, 0.6e0, 0.0e0, -0.6e0, 0.0e0,
113  + 0.0e0, 1.0e0, 0.0e0/
114 * .. Executable Statements ..
115 *
116 * Compute true values which cannot be prestored
117 * in decimal notation
118 *
119  dbtrue(1) = 1.0e0/0.6e0
120  dbtrue(3) = -1.0e0/0.6e0
121  dbtrue(5) = 1.0e0/0.6e0
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 * .. SROTGTEST ..
128  IF (k.GT.8) GO TO 40
129  sa = da1(k)
130  sb = db1(k)
131  CALL srotgtest(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: