LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ check0()

subroutine check0 ( double precision  SFAC)

Definition at line 129 of file dblat1.f.

130 * .. Parameters ..
131  INTEGER NOUT
132  parameter(nout=6)
133 * .. Scalar Arguments ..
134  DOUBLE PRECISION SFAC
135 * .. Scalars in Common ..
136  INTEGER ICASE, INCX, INCY, N
137  LOGICAL PASS
138 * .. Local Scalars ..
139  DOUBLE PRECISION SA, SB, SC, SS, D12
140  INTEGER I, K
141 * .. Local Arrays ..
142  DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
143  $ DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
144 * .. External Subroutines ..
145  EXTERNAL drotg, drotmg, stest, stest1
146 * .. Common blocks ..
147  COMMON /combla/icase, n, incx, incy, pass
148 * .. Data statements ..
149  DATA da1/0.3d0, 0.4d0, -0.3d0, -0.4d0, -0.3d0, 0.0d0,
150  + 0.0d0, 1.0d0/
151  DATA db1/0.4d0, 0.3d0, 0.4d0, 0.3d0, -0.4d0, 0.0d0,
152  + 1.0d0, 0.0d0/
153  DATA dc1/0.6d0, 0.8d0, -0.6d0, 0.8d0, 0.6d0, 1.0d0,
154  + 0.0d0, 1.0d0/
155  DATA ds1/0.8d0, 0.6d0, 0.8d0, -0.6d0, 0.8d0, 0.0d0,
156  + 1.0d0, 0.0d0/
157  DATA datrue/0.5d0, 0.5d0, 0.5d0, -0.5d0, -0.5d0,
158  + 0.0d0, 1.0d0, 1.0d0/
159  DATA dbtrue/0.0d0, 0.6d0, 0.0d0, -0.6d0, 0.0d0,
160  + 0.0d0, 1.0d0, 0.0d0/
161 * INPUT FOR MODIFIED GIVENS
162  DATA dab/ .1d0,.3d0,1.2d0,.2d0,
163  a .7d0, .2d0, .6d0, 4.2d0,
164  b 0.d0,0.d0,0.d0,0.d0,
165  c 4.d0, -1.d0, 2.d0, 4.d0,
166  d 6.d-10, 2.d-2, 1.d5, 10.d0,
167  e 4.d10, 2.d-2, 1.d-5, 10.d0,
168  f 2.d-10, 4.d-2, 1.d5, 10.d0,
169  g 2.d10, 4.d-2, 1.d-5, 10.d0,
170  h 4.d0, -2.d0, 8.d0, 4.d0 /
171 * TRUE RESULTS FOR MODIFIED GIVENS
172  DATA dtrue/0.d0,0.d0, 1.3d0, .2d0, 0.d0,0.d0,0.d0, .5d0, 0.d0,
173  a 0.d0,0.d0, 4.5d0, 4.2d0, 1.d0, .5d0, 0.d0,0.d0,0.d0,
174  b 0.d0,0.d0,0.d0,0.d0, -2.d0, 0.d0,0.d0,0.d0,0.d0,
175  c 0.d0,0.d0,0.d0, 4.d0, -1.d0, 0.d0,0.d0,0.d0,0.d0,
176  d 0.d0, 15.d-3, 0.d0, 10.d0, -1.d0, 0.d0, -1.d-4,
177  e 0.d0, 1.d0,
178  f 0.d0,0.d0, 6144.d-5, 10.d0, -1.d0, 4096.d0, -1.d6,
179  g 0.d0, 1.d0,
180  h 0.d0,0.d0,15.d0,10.d0,-1.d0, 5.d-5, 0.d0,1.d0,0.d0,
181  i 0.d0,0.d0, 15.d0, 10.d0, -1. d0, 5.d5, -4096.d0,
182  j 1.d0, 4096.d-6,
183  k 0.d0,0.d0, 7.d0, 4.d0, 0.d0,0.d0, -.5d0, -.25d0, 0.d0/
184 * 4096 = 2 ** 12
185  DATA d12 /4096.d0/
186  dtrue(1,1) = 12.d0 / 130.d0
187  dtrue(2,1) = 36.d0 / 130.d0
188  dtrue(7,1) = -1.d0 / 6.d0
189  dtrue(1,2) = 14.d0 / 75.d0
190  dtrue(2,2) = 49.d0 / 75.d0
191  dtrue(9,2) = 1.d0 / 7.d0
192  dtrue(1,5) = 45.d-11 * (d12 * d12)
193  dtrue(3,5) = 4.d5 / (3.d0 * d12)
194  dtrue(6,5) = 1.d0 / d12
195  dtrue(8,5) = 1.d4 / (3.d0 * d12)
196  dtrue(1,6) = 4.d10 / (1.5d0 * d12 * d12)
197  dtrue(2,6) = 2.d-2 / 1.5d0
198  dtrue(8,6) = 5.d-7 * d12
199  dtrue(1,7) = 4.d0 / 150.d0
200  dtrue(2,7) = (2.d-10 / 1.5d0) * (d12 * d12)
201  dtrue(7,7) = -dtrue(6,5)
202  dtrue(9,7) = 1.d4 / d12
203  dtrue(1,8) = dtrue(1,7)
204  dtrue(2,8) = 2.d10 / (1.5d0 * d12 * d12)
205  dtrue(1,9) = 32.d0 / 7.d0
206  dtrue(2,9) = -16.d0 / 7.d0
207 * .. Executable Statements ..
208 *
209 * Compute true values which cannot be prestored
210 * in decimal notation
211 *
212  dbtrue(1) = 1.0d0/0.6d0
213  dbtrue(3) = -1.0d0/0.6d0
214  dbtrue(5) = 1.0d0/0.6d0
215 *
216  DO 20 k = 1, 8
217 * .. Set N=K for identification in output if any ..
218  n = k
219  IF (icase.EQ.3) THEN
220 * .. DROTG ..
221  IF (k.GT.8) GO TO 40
222  sa = da1(k)
223  sb = db1(k)
224  CALL drotg(sa,sb,sc,ss)
225  CALL stest1(sa,datrue(k),datrue(k),sfac)
226  CALL stest1(sb,dbtrue(k),dbtrue(k),sfac)
227  CALL stest1(sc,dc1(k),dc1(k),sfac)
228  CALL stest1(ss,ds1(k),ds1(k),sfac)
229  ELSEIF (icase.EQ.11) THEN
230 * .. DROTMG ..
231  DO i=1,4
232  dtemp(i)= dab(i,k)
233  dtemp(i+4) = 0.0
234  END DO
235  dtemp(9) = 0.0
236  CALL drotmg(dtemp(1),dtemp(2),dtemp(3),dtemp(4),dtemp(5))
237  CALL stest(9,dtemp,dtrue(1,k),dtrue(1,k),sfac)
238  ELSE
239  WRITE (nout,*) ' Shouldn''t be here in CHECK0'
240  stop
241  END IF
242  20 CONTINUE
243  40 RETURN
244 *
245 * End of CHECK0
246 *
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
Definition: cblat1.f:609
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
Definition: cblat1.f:668
subroutine drotmg(DD1, DD2, DX1, DY1, DPARAM)
DROTMG
Definition: drotmg.f:90
subroutine drotg(a, b, c, s)
DROTG
Definition: drotg.f90:93
Here is the call graph for this function:
Here is the caller graph for this function: