LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ check0()

subroutine check0 ( double precision  SFAC)

Definition at line 127 of file dblat1.f.

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