1 SUBROUTINE SCKGSV( NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
2 $ NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R,
3 $ IWORK, WORK, RWORK, NIN, NOUT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, NIN, NM, NMATS, NMAX, NOUT
11 REAL THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ),
15 $ PVAL( * )
16 REAL A( * ), AF( * ), ALPHA( * ), B( * ), BETA( * ),
17 $ BF( * ), Q( * ), R( * ), RWORK( * ), U( * ),
18 $ V( * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * SCKGSV tests SGGSVD:
25 * the GSVD for M-by-N matrix A and P-by-N matrix B.
26 *
27 * Arguments
28 * =========
29 *
30 * NM (input) INTEGER
31 * The number of values of M contained in the vector MVAL.
32 *
33 * MVAL (input) INTEGER array, dimension (NM)
34 * The values of the matrix row dimension M.
35 *
36 * PVAL (input) INTEGER array, dimension (NP)
37 * The values of the matrix row dimension P.
38 *
39 * NVAL (input) INTEGER array, dimension (NN)
40 * The values of the matrix column dimension N.
41 *
42 * NMATS (input) INTEGER
43 * The number of matrix types to be tested for each combination
44 * of matrix dimensions. If NMATS >= NTYPES (the maximum
45 * number of matrix types), then all the different types are
46 * generated for testing. If NMATS < NTYPES, another input line
47 * is read to get the numbers of the matrix types to be used.
48 *
49 * ISEED (input/output) INTEGER array, dimension (4)
50 * On entry, the seed of the random number generator. The array
51 * elements should be between 0 and 4095, otherwise they will be
52 * reduced mod 4096, and ISEED(4) must be odd.
53 * On exit, the next seed in the random number sequence after
54 * all the test matrices have been generated.
55 *
56 * THRESH (input) REAL
57 * The threshold value for the test ratios. A result is
58 * included in the output file if RESULT >= THRESH. To have
59 * every test ratio printed, use THRESH = 0.
60 *
61 * NMAX (input) INTEGER
62 * The maximum value permitted for M or N, used in dimensioning
63 * the work arrays.
64 *
65 * A (workspace) REAL array, dimension (NMAX*NMAX)
66 *
67 * AF (workspace) REAL array, dimension (NMAX*NMAX)
68 *
69 * B (workspace) REAL array, dimension (NMAX*NMAX)
70 *
71 * BF (workspace) REAL array, dimension (NMAX*NMAX)
72 *
73 * U (workspace) REAL array, dimension (NMAX*NMAX)
74 *
75 * V (workspace) REAL array, dimension (NMAX*NMAX)
76 *
77 * Q (workspace) REAL array, dimension (NMAX*NMAX)
78 *
79 * ALPHA (workspace) REAL array, dimension (NMAX)
80 *
81 * BETA (workspace) REAL array, dimension (NMAX)
82 *
83 * R (workspace) REAL array, dimension (NMAX*NMAX)
84 *
85 * IWORK (workspace) INTEGER array, dimension (NMAX)
86 *
87 * WORK (workspace) REAL array, dimension (NMAX*NMAX)
88 *
89 * RWORK (workspace) REAL array, dimension (NMAX)
90 *
91 * NIN (input) INTEGER
92 * The unit number for input.
93 *
94 * NOUT (input) INTEGER
95 * The unit number for output.
96 *
97 * INFO (output) INTEGER
98 * = 0 : successful exit
99 * > 0 : If SLATMS returns an error code, the absolute value
100 * of it is returned.
101 *
102 * =====================================================================
103 *
104 * .. Parameters ..
105 INTEGER NTESTS
106 PARAMETER ( NTESTS = 7 )
107 INTEGER NTYPES
108 PARAMETER ( NTYPES = 8 )
109 * ..
110 * .. Local Scalars ..
111 LOGICAL FIRSTT
112 CHARACTER DISTA, DISTB, TYPE
113 CHARACTER*3 PATH
114 INTEGER I, IINFO, IM, IMAT, KLA, KLB, KUA, KUB, LDA,
115 $ LDB, LDQ, LDR, LDU, LDV, LWORK, M, MODEA,
116 $ MODEB, N, NFAIL, NRUN, NT, P
117 REAL ANORM, BNORM, CNDNMA, CNDNMB
118 * ..
119 * .. Local Arrays ..
120 LOGICAL DOTYPE( NTYPES )
121 REAL RESULT( NTESTS )
122 * ..
123 * .. External Subroutines ..
124 EXTERNAL ALAHDG, ALAREQ, ALASUM, SGSVTS, SLATB9, SLATMS
125 * ..
126 * .. Intrinsic Functions ..
127 INTRINSIC ABS
128 * ..
129 * .. Executable Statements ..
130 *
131 * Initialize constants and the random number seed.
132 *
133 PATH( 1: 3 ) = 'GSV'
134 INFO = 0
135 NRUN = 0
136 NFAIL = 0
137 FIRSTT = .TRUE.
138 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
139 LDA = NMAX
140 LDB = NMAX
141 LDU = NMAX
142 LDV = NMAX
143 LDQ = NMAX
144 LDR = NMAX
145 LWORK = NMAX*NMAX
146 *
147 * Do for each value of M in MVAL.
148 *
149 DO 30 IM = 1, NM
150 M = MVAL( IM )
151 P = PVAL( IM )
152 N = NVAL( IM )
153 *
154 DO 20 IMAT = 1, NTYPES
155 *
156 * Do the tests only if DOTYPE( IMAT ) is true.
157 *
158 IF( .NOT.DOTYPE( IMAT ) )
159 $ GO TO 20
160 *
161 * Set up parameters with SLATB9 and generate test
162 * matrices A and B with SLATMS.
163 *
164 CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
165 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
166 $ DISTA, DISTB )
167 *
168 * Generate M by N matrix A
169 *
170 CALL SLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
171 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
172 $ IINFO )
173 IF( IINFO.NE.0 ) THEN
174 WRITE( NOUT, FMT = 9999 )IINFO
175 INFO = ABS( IINFO )
176 GO TO 20
177 END IF
178 *
179 CALL SLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
180 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
181 $ IINFO )
182 IF( IINFO.NE.0 ) THEN
183 WRITE( NOUT, FMT = 9999 )IINFO
184 INFO = ABS( IINFO )
185 GO TO 20
186 END IF
187 *
188 NT = 6
189 *
190 CALL SGSVTS( M, P, N, A, AF, LDA, B, BF, LDB, U, LDU, V,
191 $ LDV, Q, LDQ, ALPHA, BETA, R, LDR, IWORK, WORK,
192 $ LWORK, RWORK, RESULT )
193 *
194 * Print information about the tests that did not
195 * pass the threshold.
196 *
197 DO 10 I = 1, NT
198 IF( RESULT( I ).GE.THRESH ) THEN
199 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
200 FIRSTT = .FALSE.
201 CALL ALAHDG( NOUT, PATH )
202 END IF
203 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
204 $ RESULT( I )
205 NFAIL = NFAIL + 1
206 END IF
207 10 CONTINUE
208 NRUN = NRUN + NT
209 20 CONTINUE
210 30 CONTINUE
211 *
212 * Print a summary of the results.
213 *
214 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
215 *
216 9999 FORMAT( ' SLATMS in SCKGSV INFO = ', I5 )
217 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
218 $ ', test ', I2, ', ratio=', G13.6 )
219 RETURN
220 *
221 * End of SCKGSV
222 *
223 END
2 $ NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R,
3 $ IWORK, WORK, RWORK, NIN, NOUT, INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, NIN, NM, NMATS, NMAX, NOUT
11 REAL THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ),
15 $ PVAL( * )
16 REAL A( * ), AF( * ), ALPHA( * ), B( * ), BETA( * ),
17 $ BF( * ), Q( * ), R( * ), RWORK( * ), U( * ),
18 $ V( * ), WORK( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * SCKGSV tests SGGSVD:
25 * the GSVD for M-by-N matrix A and P-by-N matrix B.
26 *
27 * Arguments
28 * =========
29 *
30 * NM (input) INTEGER
31 * The number of values of M contained in the vector MVAL.
32 *
33 * MVAL (input) INTEGER array, dimension (NM)
34 * The values of the matrix row dimension M.
35 *
36 * PVAL (input) INTEGER array, dimension (NP)
37 * The values of the matrix row dimension P.
38 *
39 * NVAL (input) INTEGER array, dimension (NN)
40 * The values of the matrix column dimension N.
41 *
42 * NMATS (input) INTEGER
43 * The number of matrix types to be tested for each combination
44 * of matrix dimensions. If NMATS >= NTYPES (the maximum
45 * number of matrix types), then all the different types are
46 * generated for testing. If NMATS < NTYPES, another input line
47 * is read to get the numbers of the matrix types to be used.
48 *
49 * ISEED (input/output) INTEGER array, dimension (4)
50 * On entry, the seed of the random number generator. The array
51 * elements should be between 0 and 4095, otherwise they will be
52 * reduced mod 4096, and ISEED(4) must be odd.
53 * On exit, the next seed in the random number sequence after
54 * all the test matrices have been generated.
55 *
56 * THRESH (input) REAL
57 * The threshold value for the test ratios. A result is
58 * included in the output file if RESULT >= THRESH. To have
59 * every test ratio printed, use THRESH = 0.
60 *
61 * NMAX (input) INTEGER
62 * The maximum value permitted for M or N, used in dimensioning
63 * the work arrays.
64 *
65 * A (workspace) REAL array, dimension (NMAX*NMAX)
66 *
67 * AF (workspace) REAL array, dimension (NMAX*NMAX)
68 *
69 * B (workspace) REAL array, dimension (NMAX*NMAX)
70 *
71 * BF (workspace) REAL array, dimension (NMAX*NMAX)
72 *
73 * U (workspace) REAL array, dimension (NMAX*NMAX)
74 *
75 * V (workspace) REAL array, dimension (NMAX*NMAX)
76 *
77 * Q (workspace) REAL array, dimension (NMAX*NMAX)
78 *
79 * ALPHA (workspace) REAL array, dimension (NMAX)
80 *
81 * BETA (workspace) REAL array, dimension (NMAX)
82 *
83 * R (workspace) REAL array, dimension (NMAX*NMAX)
84 *
85 * IWORK (workspace) INTEGER array, dimension (NMAX)
86 *
87 * WORK (workspace) REAL array, dimension (NMAX*NMAX)
88 *
89 * RWORK (workspace) REAL array, dimension (NMAX)
90 *
91 * NIN (input) INTEGER
92 * The unit number for input.
93 *
94 * NOUT (input) INTEGER
95 * The unit number for output.
96 *
97 * INFO (output) INTEGER
98 * = 0 : successful exit
99 * > 0 : If SLATMS returns an error code, the absolute value
100 * of it is returned.
101 *
102 * =====================================================================
103 *
104 * .. Parameters ..
105 INTEGER NTESTS
106 PARAMETER ( NTESTS = 7 )
107 INTEGER NTYPES
108 PARAMETER ( NTYPES = 8 )
109 * ..
110 * .. Local Scalars ..
111 LOGICAL FIRSTT
112 CHARACTER DISTA, DISTB, TYPE
113 CHARACTER*3 PATH
114 INTEGER I, IINFO, IM, IMAT, KLA, KLB, KUA, KUB, LDA,
115 $ LDB, LDQ, LDR, LDU, LDV, LWORK, M, MODEA,
116 $ MODEB, N, NFAIL, NRUN, NT, P
117 REAL ANORM, BNORM, CNDNMA, CNDNMB
118 * ..
119 * .. Local Arrays ..
120 LOGICAL DOTYPE( NTYPES )
121 REAL RESULT( NTESTS )
122 * ..
123 * .. External Subroutines ..
124 EXTERNAL ALAHDG, ALAREQ, ALASUM, SGSVTS, SLATB9, SLATMS
125 * ..
126 * .. Intrinsic Functions ..
127 INTRINSIC ABS
128 * ..
129 * .. Executable Statements ..
130 *
131 * Initialize constants and the random number seed.
132 *
133 PATH( 1: 3 ) = 'GSV'
134 INFO = 0
135 NRUN = 0
136 NFAIL = 0
137 FIRSTT = .TRUE.
138 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
139 LDA = NMAX
140 LDB = NMAX
141 LDU = NMAX
142 LDV = NMAX
143 LDQ = NMAX
144 LDR = NMAX
145 LWORK = NMAX*NMAX
146 *
147 * Do for each value of M in MVAL.
148 *
149 DO 30 IM = 1, NM
150 M = MVAL( IM )
151 P = PVAL( IM )
152 N = NVAL( IM )
153 *
154 DO 20 IMAT = 1, NTYPES
155 *
156 * Do the tests only if DOTYPE( IMAT ) is true.
157 *
158 IF( .NOT.DOTYPE( IMAT ) )
159 $ GO TO 20
160 *
161 * Set up parameters with SLATB9 and generate test
162 * matrices A and B with SLATMS.
163 *
164 CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
165 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
166 $ DISTA, DISTB )
167 *
168 * Generate M by N matrix A
169 *
170 CALL SLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
171 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
172 $ IINFO )
173 IF( IINFO.NE.0 ) THEN
174 WRITE( NOUT, FMT = 9999 )IINFO
175 INFO = ABS( IINFO )
176 GO TO 20
177 END IF
178 *
179 CALL SLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
180 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
181 $ IINFO )
182 IF( IINFO.NE.0 ) THEN
183 WRITE( NOUT, FMT = 9999 )IINFO
184 INFO = ABS( IINFO )
185 GO TO 20
186 END IF
187 *
188 NT = 6
189 *
190 CALL SGSVTS( M, P, N, A, AF, LDA, B, BF, LDB, U, LDU, V,
191 $ LDV, Q, LDQ, ALPHA, BETA, R, LDR, IWORK, WORK,
192 $ LWORK, RWORK, RESULT )
193 *
194 * Print information about the tests that did not
195 * pass the threshold.
196 *
197 DO 10 I = 1, NT
198 IF( RESULT( I ).GE.THRESH ) THEN
199 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
200 FIRSTT = .FALSE.
201 CALL ALAHDG( NOUT, PATH )
202 END IF
203 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
204 $ RESULT( I )
205 NFAIL = NFAIL + 1
206 END IF
207 10 CONTINUE
208 NRUN = NRUN + NT
209 20 CONTINUE
210 30 CONTINUE
211 *
212 * Print a summary of the results.
213 *
214 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
215 *
216 9999 FORMAT( ' SLATMS in SCKGSV INFO = ', I5 )
217 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
218 $ ', test ', I2, ', ratio=', G13.6 )
219 RETURN
220 *
221 * End of SCKGSV
222 *
223 END