134 DOUBLE PRECISION SFAC
136 INTEGER ICASE, INCX, INCY, N
139 DOUBLE PRECISION SA, SB, SC, SS, D12
142 DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
143 $ DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
147 COMMON /combla/icase, n, incx, incy, pass
149 DATA da1/0.3d0, 0.4d0, -0.3d0, -0.4d0, -0.3d0, 0.0d0,
151 DATA db1/0.4d0, 0.3d0, 0.4d0, 0.3d0, -0.4d0, 0.0d0,
153 DATA dc1/0.6d0, 0.8d0, -0.6d0, 0.8d0, 0.6d0, 1.0d0,
155 DATA ds1/0.8d0, 0.6d0, 0.8d0, -0.6d0, 0.8d0, 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/
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 /
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,
178 f 0.d0,0.d0, 6144.d-5, 10.d0, -1.d0, 4096.d0, -1.d6,
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,
183 k 0.d0,0.d0, 7.d0, 4.d0, 0.d0,0.d0, -.5d0, -.25d0, 0.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
212 dbtrue(1) = 1.0d0/0.6d0
213 dbtrue(3) = -1.0d0/0.6d0
214 dbtrue(5) = 1.0d0/0.6d0
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
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)
239 WRITE (nout,*)
' Shouldn''t be here in CHECK0'
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
subroutine drotmg(DD1, DD2, DX1, DY1, DPARAM)
DROTMG
subroutine drotg(a, b, c, s)
DROTG