numeric-linalg

Educational material on the SciPy implementation of numerical linear algebra algorithms

NameSizeMode
..
lapack/TESTING/EIG/cchkgg.f 45211B -rw-r--r--
0001
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
0032
0033
0034
0035
0036
0037
0038
0039
0040
0041
0042
0043
0044
0045
0046
0047
0048
0049
0050
0051
0052
0053
0054
0055
0056
0057
0058
0059
0060
0061
0062
0063
0064
0065
0066
0067
0068
0069
0070
0071
0072
0073
0074
0075
0076
0077
0078
0079
0080
0081
0082
0083
0084
0085
0086
0087
0088
0089
0090
0091
0092
0093
0094
0095
0096
0097
0098
0099
0100
0101
0102
0103
0104
0105
0106
0107
0108
0109
0110
0111
0112
0113
0114
0115
0116
0117
0118
0119
0120
0121
0122
0123
0124
0125
0126
0127
0128
0129
0130
0131
0132
0133
0134
0135
0136
0137
0138
0139
0140
0141
0142
0143
0144
0145
0146
0147
0148
0149
0150
0151
0152
0153
0154
0155
0156
0157
0158
0159
0160
0161
0162
0163
0164
0165
0166
0167
0168
0169
0170
0171
0172
0173
0174
0175
0176
0177
0178
0179
0180
0181
0182
0183
0184
0185
0186
0187
0188
0189
0190
0191
0192
0193
0194
0195
0196
0197
0198
0199
0200
0201
0202
0203
0204
0205
0206
0207
0208
0209
0210
0211
0212
0213
0214
0215
0216
0217
0218
0219
0220
0221
0222
0223
0224
0225
0226
0227
0228
0229
0230
0231
0232
0233
0234
0235
0236
0237
0238
0239
0240
0241
0242
0243
0244
0245
0246
0247
0248
0249
0250
0251
0252
0253
0254
0255
0256
0257
0258
0259
0260
0261
0262
0263
0264
0265
0266
0267
0268
0269
0270
0271
0272
0273
0274
0275
0276
0277
0278
0279
0280
0281
0282
0283
0284
0285
0286
0287
0288
0289
0290
0291
0292
0293
0294
0295
0296
0297
0298
0299
0300
0301
0302
0303
0304
0305
0306
0307
0308
0309
0310
0311
0312
0313
0314
0315
0316
0317
0318
0319
0320
0321
0322
0323
0324
0325
0326
0327
0328
0329
0330
0331
0332
0333
0334
0335
0336
0337
0338
0339
0340
0341
0342
0343
0344
0345
0346
0347
0348
0349
0350
0351
0352
0353
0354
0355
0356
0357
0358
0359
0360
0361
0362
0363
0364
0365
0366
0367
0368
0369
0370
0371
0372
0373
0374
0375
0376
0377
0378
0379
0380
0381
0382
0383
0384
0385
0386
0387
0388
0389
0390
0391
0392
0393
0394
0395
0396
0397
0398
0399
0400
0401
0402
0403
0404
0405
0406
0407
0408
0409
0410
0411
0412
0413
0414
0415
0416
0417
0418
0419
0420
0421
0422
0423
0424
0425
0426
0427
0428
0429
0430
0431
0432
0433
0434
0435
0436
0437
0438
0439
0440
0441
0442
0443
0444
0445
0446
0447
0448
0449
0450
0451
0452
0453
0454
0455
0456
0457
0458
0459
0460
0461
0462
0463
0464
0465
0466
0467
0468
0469
0470
0471
0472
0473
0474
0475
0476
0477
0478
0479
0480
0481
0482
0483
0484
0485
0486
0487
0488
0489
0490
0491
0492
0493
0494
0495
0496
0497
0498
0499
0500
0501
0502
0503
0504
0505
0506
0507
0508
0509
0510
0511
0512
0513
0514
0515
0516
0517
0518
0519
0520
0521
0522
0523
0524
0525
0526
0527
0528
0529
0530
0531
0532
0533
0534
0535
0536
0537
0538
0539
0540
0541
0542
0543
0544
0545
0546
0547
0548
0549
0550
0551
0552
0553
0554
0555
0556
0557
0558
0559
0560
0561
0562
0563
0564
0565
0566
0567
0568
0569
0570
0571
0572
0573
0574
0575
0576
0577
0578
0579
0580
0581
0582
0583
0584
0585
0586
0587
0588
0589
0590
0591
0592
0593
0594
0595
0596
0597
0598
0599
0600
0601
0602
0603
0604
0605
0606
0607
0608
0609
0610
0611
0612
0613
0614
0615
0616
0617
0618
0619
0620
0621
0622
0623
0624
0625
0626
0627
0628
0629
0630
0631
0632
0633
0634
0635
0636
0637
0638
0639
0640
0641
0642
0643
0644
0645
0646
0647
0648
0649
0650
0651
0652
0653
0654
0655
0656
0657
0658
0659
0660
0661
0662
0663
0664
0665
0666
0667
0668
0669
0670
0671
0672
0673
0674
0675
0676
0677
0678
0679
0680
0681
0682
0683
0684
0685
0686
0687
0688
0689
0690
0691
0692
0693
0694
0695
0696
0697
0698
0699
0700
0701
0702
0703
0704
0705
0706
0707
0708
0709
0710
0711
0712
0713
0714
0715
0716
0717
0718
0719
0720
0721
0722
0723
0724
0725
0726
0727
0728
0729
0730
0731
0732
0733
0734
0735
0736
0737
0738
0739
0740
0741
0742
0743
0744
0745
0746
0747
0748
0749
0750
0751
0752
0753
0754
0755
0756
0757
0758
0759
0760
0761
0762
0763
0764
0765
0766
0767
0768
0769
0770
0771
0772
0773
0774
0775
0776
0777
0778
0779
0780
0781
0782
0783
0784
0785
0786
0787
0788
0789
0790
0791
0792
0793
0794
0795
0796
0797
0798
0799
0800
0801
0802
0803
0804
0805
0806
0807
0808
0809
0810
0811
0812
0813
0814
0815
0816
0817
0818
0819
0820
0821
0822
0823
0824
0825
0826
0827
0828
0829
0830
0831
0832
0833
0834
0835
0836
0837
0838
0839
0840
0841
0842
0843
0844
0845
0846
0847
0848
0849
0850
0851
0852
0853
0854
0855
0856
0857
0858
0859
0860
0861
0862
0863
0864
0865
0866
0867
0868
0869
0870
0871
0872
0873
0874
0875
0876
0877
0878
0879
0880
0881
0882
0883
0884
0885
0886
0887
0888
0889
0890
0891
0892
0893
0894
0895
0896
0897
0898
0899
0900
0901
0902
0903
0904
0905
0906
0907
0908
0909
0910
0911
0912
0913
0914
0915
0916
0917
0918
0919
0920
0921
0922
0923
0924
0925
0926
0927
0928
0929
0930
0931
0932
0933
0934
0935
0936
0937
0938
0939
0940
0941
0942
0943
0944
0945
0946
0947
0948
0949
0950
0951
0952
0953
0954
0955
0956
0957
0958
0959
0960
0961
0962
0963
0964
0965
0966
0967
0968
0969
0970
0971
0972
0973
0974
0975
0976
0977
0978
0979
0980
0981
0982
0983
0984
0985
0986
0987
0988
0989
0990
0991
0992
0993
0994
0995
0996
0997
0998
0999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
*> \brief \b CCHKGG
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Definition:
*  ===========
*
*       SUBROUTINE CCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
*                          TSTDIF, THRSHN, NOUNIT, A, LDA, B, H, T, S1,
*                          S2, P1, P2, U, LDU, V, Q, Z, ALPHA1, BETA1,
*                          ALPHA3, BETA3, EVECTL, EVECTR, WORK, LWORK,
*                          RWORK, LLWORK, RESULT, INFO )
*
*       .. Scalar Arguments ..
*       LOGICAL            TSTDIF
*       INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES
*       REAL               THRESH, THRSHN
*       ..
*       .. Array Arguments ..
*       LOGICAL            DOTYPE( * ), LLWORK( * )
*       INTEGER            ISEED( 4 ), NN( * )
*       REAL               RESULT( 15 ), RWORK( * )
*       COMPLEX            A( LDA, * ), ALPHA1( * ), ALPHA3( * ),
*      $                   B( LDA, * ), BETA1( * ), BETA3( * ),
*      $                   EVECTL( LDU, * ), EVECTR( LDU, * ),
*      $                   H( LDA, * ), P1( LDA, * ), P2( LDA, * ),
*      $                   Q( LDU, * ), S1( LDA, * ), S2( LDA, * ),
*      $                   T( LDA, * ), U( LDU, * ), V( LDU, * ),
*      $                   WORK( * ), Z( LDU, * )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> CCHKGG  checks the nonsymmetric generalized eigenvalue problem
*> routines.
*>                                H          H        H
*> CGGHRD factors A and B as U H V  and U T V , where   means conjugate
*> transpose, H is hessenberg, T is triangular and U and V are unitary.
*>
*>                                 H          H
*> CHGEQZ factors H and T as  Q S Z  and Q P Z , where P and S are upper
*> triangular and Q and Z are unitary.  It also computes the generalized
*> eigenvalues (alpha(1),beta(1)),...,(alpha(n),beta(n)), where
*> alpha(j)=S(j,j) and beta(j)=P(j,j) -- thus, w(j) = alpha(j)/beta(j)
*> is a root of the generalized eigenvalue problem
*>
*>     det( A - w(j) B ) = 0
*>
*> and m(j) = beta(j)/alpha(j) is a root of the essentially equivalent
*> problem
*>
*>     det( m(j) A - B ) = 0
*>
*> CTGEVC computes the matrix L of left eigenvectors and the matrix R
*> of right eigenvectors for the matrix pair ( S, P ).  In the
*> description below,  l and r are left and right eigenvectors
*> corresponding to the generalized eigenvalues (alpha,beta).
*>
*> When CCHKGG is called, a number of matrix "sizes" ("n's") and a
*> number of matrix "types" are specified.  For each size ("n")
*> and each type of matrix, one matrix will be generated and used
*> to test the nonsymmetric eigenroutines.  For each matrix, 13
*> tests will be performed.  The first twelve "test ratios" should be
*> small -- O(1).  They will be compared with the threshold THRESH:
*>
*>                  H
*> (1)   | A - U H V  | / ( |A| n ulp )
*>
*>                  H
*> (2)   | B - U T V  | / ( |B| n ulp )
*>
*>               H
*> (3)   | I - UU  | / ( n ulp )
*>
*>               H
*> (4)   | I - VV  | / ( n ulp )
*>
*>                  H
*> (5)   | H - Q S Z  | / ( |H| n ulp )
*>
*>                  H
*> (6)   | T - Q P Z  | / ( |T| n ulp )
*>
*>               H
*> (7)   | I - QQ  | / ( n ulp )
*>
*>               H
*> (8)   | I - ZZ  | / ( n ulp )
*>
*> (9)   max over all left eigenvalue/-vector pairs (beta/alpha,l) of
*>                           H
*>       | (beta A - alpha B) l | / ( ulp max( |beta A|, |alpha B| ) )
*>
*> (10)  max over all left eigenvalue/-vector pairs (beta/alpha,l') of
*>                           H
*>       | (beta H - alpha T) l' | / ( ulp max( |beta H|, |alpha T| ) )
*>
*>       where the eigenvectors l' are the result of passing Q to
*>       STGEVC and back transforming (JOB='B').
*>
*> (11)  max over all right eigenvalue/-vector pairs (beta/alpha,r) of
*>
*>       | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )
*>
*> (12)  max over all right eigenvalue/-vector pairs (beta/alpha,r') of
*>
*>       | (beta H - alpha T) r' | / ( ulp max( |beta H|, |alpha T| ) )
*>
*>       where the eigenvectors r' are the result of passing Z to
*>       STGEVC and back transforming (JOB='B').
*>
*> The last three test ratios will usually be small, but there is no
*> mathematical requirement that they be so.  They are therefore
*> compared with THRESH only if TSTDIF is .TRUE.
*>
*> (13)  | S(Q,Z computed) - S(Q,Z not computed) | / ( |S| ulp )
*>
*> (14)  | P(Q,Z computed) - P(Q,Z not computed) | / ( |P| ulp )
*>
*> (15)  max( |alpha(Q,Z computed) - alpha(Q,Z not computed)|/|S| ,
*>            |beta(Q,Z computed) - beta(Q,Z not computed)|/|P| ) / ulp
*>
*> In addition, the normalization of L and R are checked, and compared
*> with the threshold THRSHN.
*>
*> Test Matrices
*> ---- --------
*>
*> The sizes of the test matrices are specified by an array
*> NN(1:NSIZES); the value of each element NN(j) specifies one size.
*> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); if
*> DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
*> Currently, the list of possible types is:
*>
*> (1)  ( 0, 0 )         (a pair of zero matrices)
*>
*> (2)  ( I, 0 )         (an identity and a zero matrix)
*>
*> (3)  ( 0, I )         (an identity and a zero matrix)
*>
*> (4)  ( I, I )         (a pair of identity matrices)
*>
*>         t   t
*> (5)  ( J , J  )       (a pair of transposed Jordan blocks)
*>
*>                                     t                ( I   0  )
*> (6)  ( X, Y )         where  X = ( J   0  )  and Y = (      t )
*>                                  ( 0   I  )          ( 0   J  )
*>                       and I is a k x k identity and J a (k+1)x(k+1)
*>                       Jordan block; k=(N-1)/2
*>
*> (7)  ( D, I )         where D is P*D1, P is a random unitary diagonal
*>                       matrix (i.e., with random magnitude 1 entries
*>                       on the diagonal), and D1=diag( 0, 1,..., N-1 )
*>                       (i.e., a diagonal matrix with D1(1,1)=0,
*>                       D1(2,2)=1, ..., D1(N,N)=N-1.)
*> (8)  ( I, D )
*>
*> (9)  ( big*D, small*I ) where "big" is near overflow and small=1/big
*>
*> (10) ( small*D, big*I )
*>
*> (11) ( big*I, small*D )
*>
*> (12) ( small*I, big*D )
*>
*> (13) ( big*D, big*I )
*>
*> (14) ( small*D, small*I )
*>
*> (15) ( D1, D2 )        where D1=P*diag( 0, 0, 1, ..., N-3, 0 ) and
*>                        D2=Q*diag( 0, N-3, N-4,..., 1, 0, 0 ), and
*>                        P and Q are random unitary diagonal matrices.
*>           t   t
*> (16) U ( J , J ) V     where U and V are random unitary matrices.
*>
*> (17) U ( T1, T2 ) V    where T1 and T2 are upper triangular matrices
*>                        with random O(1) entries above the diagonal
*>                        and diagonal entries diag(T1) =
*>                        P*( 0, 0, 1, ..., N-3, 0 ) and diag(T2) =
*>                        Q*( 0, N-3, N-4,..., 1, 0, 0 )
*>
*> (18) U ( T1, T2 ) V    diag(T1) = ( 0, 0, 1, 1, s, ..., s, 0 )
*>                        diag(T2) = ( 0, 1, 0, 1,..., 1, 0 )
*>                        s = machine precision.
*>
*> (19) U ( T1, T2 ) V    diag(T1)=( 0,0,1,1, 1-d, ..., 1-(N-5)*d=s, 0 )
*>                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0 )
*>
*>                                                        N-5
*> (20) U ( T1, T2 ) V    diag(T1)=( 0, 0, 1, 1, a, ..., a   =s, 0 )
*>                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 )
*>
*> (21) U ( T1, T2 ) V    diag(T1)=( 0, 0, 1, r1, r2, ..., r(N-4), 0 )
*>                        diag(T2) = ( 0, 1, 0, 1, ..., 1, 0, 0 )
*>                        where r1,..., r(N-4) are random.
*>
*> (22) U ( big*T1, small*T2 ) V   diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
*>                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )
*>
*> (23) U ( small*T1, big*T2 ) V   diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
*>                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )
*>
*> (24) U ( small*T1, small*T2 ) V diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
*>                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )
*>
*> (25) U ( big*T1, big*T2 ) V     diag(T1) = P*( 0, 0, 1, ..., N-3, 0 )
*>                                 diag(T2) = ( 0, 1, ..., 1, 0, 0 )
*>
*> (26) U ( T1, T2 ) V     where T1 and T2 are random upper-triangular
*>                         matrices.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] NSIZES
*> \verbatim
*>          NSIZES is INTEGER
*>          The number of sizes of matrices to use.  If it is zero,
*>          CCHKGG does nothing.  It must be at least zero.
*> \endverbatim
*>
*> \param[in] NN
*> \verbatim
*>          NN is INTEGER array, dimension (NSIZES)
*>          An array containing the sizes to be used for the matrices.
*>          Zero values will be skipped.  The values must be at least
*>          zero.
*> \endverbatim
*>
*> \param[in] NTYPES
*> \verbatim
*>          NTYPES is INTEGER
*>          The number of elements in DOTYPE.   If it is zero, CCHKGG
*>          does nothing.  It must be at least zero.  If it is MAXTYP+1
*>          and NSIZES is 1, then an additional type, MAXTYP+1 is
*>          defined, which is to use whatever matrix is in A.  This
*>          is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
*>          DOTYPE(MAXTYP+1) is .TRUE. .
*> \endverbatim
*>
*> \param[in] DOTYPE
*> \verbatim
*>          DOTYPE is LOGICAL array, dimension (NTYPES)
*>          If DOTYPE(j) is .TRUE., then for each size in NN a
*>          matrix of that size and of type j will be generated.
*>          If NTYPES is smaller than the maximum number of types
*>          defined (PARAMETER MAXTYP), then types NTYPES+1 through
*>          MAXTYP will not be generated.  If NTYPES is larger
*>          than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
*>          will be ignored.
*> \endverbatim
*>
*> \param[in,out] ISEED
*> \verbatim
*>          ISEED is INTEGER array, dimension (4)
*>          On entry ISEED specifies the seed of the random number
*>          generator. The array elements should be between 0 and 4095;
*>          if not they will be reduced mod 4096.  Also, ISEED(4) must
*>          be odd.  The random number generator uses a linear
*>          congruential sequence limited to small integers, and so
*>          should produce machine independent random numbers. The
*>          values of ISEED are changed on exit, and can be used in the
*>          next call to CCHKGG to continue the same random number
*>          sequence.
*> \endverbatim
*>
*> \param[in] THRESH
*> \verbatim
*>          THRESH is REAL
*>          A test will count as "failed" if the "error", computed as
*>          described above, exceeds THRESH.  Note that the error
*>          is scaled to be O(1), so THRESH should be a reasonably
*>          small multiple of 1, e.g., 10 or 100.  In particular,
*>          it should not depend on the precision (single vs. double)
*>          or the size of the matrix.  It must be at least zero.
*> \endverbatim
*>
*> \param[in] TSTDIF
*> \verbatim
*>          TSTDIF is LOGICAL
*>          Specifies whether test ratios 13-15 will be computed and
*>          compared with THRESH.
*>          = .FALSE.: Only test ratios 1-12 will be computed and tested.
*>                     Ratios 13-15 will be set to zero.
*>          = .TRUE.:  All the test ratios 1-15 will be computed and
*>                     tested.
*> \endverbatim
*>
*> \param[in] THRSHN
*> \verbatim
*>          THRSHN is REAL
*>          Threshold for reporting eigenvector normalization error.
*>          If the normalization of any eigenvector differs from 1 by
*>          more than THRSHN*ulp, then a special error message will be
*>          printed.  (This is handled separately from the other tests,
*>          since only a compiler or programming error should cause an
*>          error message, at least if THRSHN is at least 5--10.)
*> \endverbatim
*>
*> \param[in] NOUNIT
*> \verbatim
*>          NOUNIT is INTEGER
*>          The FORTRAN unit number for printing out error messages
*>          (e.g., if a routine returns IINFO not equal to 0.)
*> \endverbatim
*>
*> \param[in,out] A
*> \verbatim
*>          A is COMPLEX array, dimension (LDA, max(NN))
*>          Used to hold the original A matrix.  Used as input only
*>          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and
*>          DOTYPE(MAXTYP+1)=.TRUE.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*>          LDA is INTEGER
*>          The leading dimension of A, B, H, T, S1, P1, S2, and P2.
*>          It must be at least 1 and at least max( NN ).
*> \endverbatim
*>
*> \param[in,out] B
*> \verbatim
*>          B is COMPLEX array, dimension (LDA, max(NN))
*>          Used to hold the original B matrix.  Used as input only
*>          if NTYPES=MAXTYP+1, DOTYPE(1:MAXTYP)=.FALSE., and
*>          DOTYPE(MAXTYP+1)=.TRUE.
*> \endverbatim
*>
*> \param[out] H
*> \verbatim
*>          H is COMPLEX array, dimension (LDA, max(NN))
*>          The upper Hessenberg matrix computed from A by CGGHRD.
*> \endverbatim
*>
*> \param[out] T
*> \verbatim
*>          T is COMPLEX array, dimension (LDA, max(NN))
*>          The upper triangular matrix computed from B by CGGHRD.
*> \endverbatim
*>
*> \param[out] S1
*> \verbatim
*>          S1 is COMPLEX array, dimension (LDA, max(NN))
*>          The Schur (upper triangular) matrix computed from H by CHGEQZ
*>          when Q and Z are also computed.
*> \endverbatim
*>
*> \param[out] S2
*> \verbatim
*>          S2 is COMPLEX array, dimension (LDA, max(NN))
*>          The Schur (upper triangular) matrix computed from H by CHGEQZ
*>          when Q and Z are not computed.
*> \endverbatim
*>
*> \param[out] P1
*> \verbatim
*>          P1 is COMPLEX array, dimension (LDA, max(NN))
*>          The upper triangular matrix computed from T by CHGEQZ
*>          when Q and Z are also computed.
*> \endverbatim
*>
*> \param[out] P2
*> \verbatim
*>          P2 is COMPLEX array, dimension (LDA, max(NN))
*>          The upper triangular matrix computed from T by CHGEQZ
*>          when Q and Z are not computed.
*> \endverbatim
*>
*> \param[out] U
*> \verbatim
*>          U is COMPLEX array, dimension (LDU, max(NN))
*>          The (left) unitary matrix computed by CGGHRD.
*> \endverbatim
*>
*> \param[in] LDU
*> \verbatim
*>          LDU is INTEGER
*>          The leading dimension of U, V, Q, Z, EVECTL, and EVECTR.  It
*>          must be at least 1 and at least max( NN ).
*> \endverbatim
*>
*> \param[out] V
*> \verbatim
*>          V is COMPLEX array, dimension (LDU, max(NN))
*>          The (right) unitary matrix computed by CGGHRD.
*> \endverbatim
*>
*> \param[out] Q
*> \verbatim
*>          Q is COMPLEX array, dimension (LDU, max(NN))
*>          The (left) unitary matrix computed by CHGEQZ.
*> \endverbatim
*>
*> \param[out] Z
*> \verbatim
*>          Z is COMPLEX array, dimension (LDU, max(NN))
*>          The (left) unitary matrix computed by CHGEQZ.
*> \endverbatim
*>
*> \param[out] ALPHA1
*> \verbatim
*>          ALPHA1 is COMPLEX array, dimension (max(NN))
*> \endverbatim
*>
*> \param[out] BETA1
*> \verbatim
*>          BETA1 is COMPLEX array, dimension (max(NN))
*>          The generalized eigenvalues of (A,B) computed by CHGEQZ
*>          when Q, Z, and the full Schur matrices are computed.
*> \endverbatim
*>
*> \param[out] ALPHA3
*> \verbatim
*>          ALPHA3 is COMPLEX array, dimension (max(NN))
*> \endverbatim
*>
*> \param[out] BETA3
*> \verbatim
*>          BETA3 is COMPLEX array, dimension (max(NN))
*>          The generalized eigenvalues of (A,B) computed by CHGEQZ
*>          when neither Q, Z, nor the Schur matrices are computed.
*> \endverbatim
*>
*> \param[out] EVECTL
*> \verbatim
*>          EVECTL is COMPLEX array, dimension (LDU, max(NN))
*>          The (lower triangular) left eigenvector matrix for the
*>          matrices in S1 and P1.
*> \endverbatim
*>
*> \param[out] EVECTR
*> \verbatim
*>          EVECTR is COMPLEX array, dimension (LDU, max(NN))
*>          The (upper triangular) right eigenvector matrix for the
*>          matrices in S1 and P1.
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is COMPLEX array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*>          LWORK is INTEGER
*>          The number of entries in WORK.  This must be at least
*>          max( 4*N, 2 * N**2, 1 ), for all N=NN(j).
*> \endverbatim
*>
*> \param[out] RWORK
*> \verbatim
*>          RWORK is REAL array, dimension (2*max(NN))
*> \endverbatim
*>
*> \param[out] LLWORK
*> \verbatim
*>          LLWORK is LOGICAL array, dimension (max(NN))
*> \endverbatim
*>
*> \param[out] RESULT
*> \verbatim
*>          RESULT is REAL array, dimension (15)
*>          The values computed by the tests described above.
*>          The values are currently limited to 1/ulp, to avoid
*>          overflow.
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          INFO is INTEGER
*>          = 0:  successful exit.
*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
*>          > 0:  A routine returned an error code.  INFO is the
*>                absolute value of the INFO value returned.
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex_eig
*
*  =====================================================================
      SUBROUTINE CCHKGG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
     $                   TSTDIF, THRSHN, NOUNIT, A, LDA, B, H, T, S1,
     $                   S2, P1, P2, U, LDU, V, Q, Z, ALPHA1, BETA1,
     $                   ALPHA3, BETA3, EVECTL, EVECTR, WORK, LWORK,
     $                   RWORK, LLWORK, RESULT, INFO )
*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      LOGICAL            TSTDIF
      INTEGER            INFO, LDA, LDU, LWORK, NOUNIT, NSIZES, NTYPES
      REAL               THRESH, THRSHN
*     ..
*     .. Array Arguments ..
      LOGICAL            DOTYPE( * ), LLWORK( * )
      INTEGER            ISEED( 4 ), NN( * )
      REAL               RESULT( 15 ), RWORK( * )
      COMPLEX            A( LDA, * ), ALPHA1( * ), ALPHA3( * ),
     $                   B( LDA, * ), BETA1( * ), BETA3( * ),
     $                   EVECTL( LDU, * ), EVECTR( LDU, * ),
     $                   H( LDA, * ), P1( LDA, * ), P2( LDA, * ),
     $                   Q( LDU, * ), S1( LDA, * ), S2( LDA, * ),
     $                   T( LDA, * ), U( LDU, * ), V( LDU, * ),
     $                   WORK( * ), Z( LDU, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
      COMPLEX            CZERO, CONE
      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
     $                   CONE = ( 1.0E+0, 0.0E+0 ) )
      INTEGER            MAXTYP
      PARAMETER          ( MAXTYP = 26 )
*     ..
*     .. Local Scalars ..
      LOGICAL            BADNN
      INTEGER            I1, IADD, IINFO, IN, J, JC, JR, JSIZE, JTYPE,
     $                   LWKOPT, MTYPES, N, N1, NERRS, NMATS, NMAX,
     $                   NTEST, NTESTT
      REAL               ANORM, BNORM, SAFMAX, SAFMIN, TEMP1, TEMP2,
     $                   ULP, ULPINV
      COMPLEX            CTEMP
*     ..
*     .. Local Arrays ..
      LOGICAL            LASIGN( MAXTYP ), LBSIGN( MAXTYP )
      INTEGER            IOLDSD( 4 ), KADD( 6 ), KAMAGN( MAXTYP ),
     $                   KATYPE( MAXTYP ), KAZERO( MAXTYP ),
     $                   KBMAGN( MAXTYP ), KBTYPE( MAXTYP ),
     $                   KBZERO( MAXTYP ), KCLASS( MAXTYP ),
     $                   KTRIAN( MAXTYP ), KZ1( 6 ), KZ2( 6 )
      REAL               DUMMA( 4 ), RMAGN( 0: 3 )
      COMPLEX            CDUMMA( 4 )
*     ..
*     .. External Functions ..
      REAL               CLANGE, SLAMCH
      COMPLEX            CLARND
      EXTERNAL           CLANGE, SLAMCH, CLARND
*     ..
*     .. External Subroutines ..
      EXTERNAL           CGEQR2, CGET51, CGET52, CGGHRD, CHGEQZ, CLACPY,
     $                   CLARFG, CLASET, CLATM4, CTGEVC, CUNM2R, SLASUM,
     $                   XERBLA
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABS, CONJG, MAX, MIN, REAL, SIGN
*     ..
*     .. Data statements ..
      DATA               KCLASS / 15*1, 10*2, 1*3 /
      DATA               KZ1 / 0, 1, 2, 1, 3, 3 /
      DATA               KZ2 / 0, 0, 1, 2, 1, 1 /
      DATA               KADD / 0, 0, 0, 0, 3, 2 /
      DATA               KATYPE / 0, 1, 0, 1, 2, 3, 4, 1, 4, 4, 1, 1, 4,
     $                   4, 4, 2, 4, 5, 8, 7, 9, 4*4, 0 /
      DATA               KBTYPE / 0, 0, 1, 1, 2, -3, 1, 4, 1, 1, 4, 4,
     $                   1, 1, -4, 2, -4, 8*8, 0 /
      DATA               KAZERO / 6*1, 2, 1, 2*2, 2*1, 2*2, 3, 1, 3,
     $                   4*5, 4*3, 1 /
      DATA               KBZERO / 6*1, 1, 2, 2*1, 2*2, 2*1, 4, 1, 4,
     $                   4*6, 4*4, 1 /
      DATA               KAMAGN / 8*1, 2, 3, 2, 3, 2, 3, 7*1, 2, 3, 3,
     $                   2, 1 /
      DATA               KBMAGN / 8*1, 3, 2, 3, 2, 2, 3, 7*1, 3, 2, 3,
     $                   2, 1 /
      DATA               KTRIAN / 16*0, 10*1 /
      DATA               LASIGN / 6*.FALSE., .TRUE., .FALSE., 2*.TRUE.,
     $                   2*.FALSE., 3*.TRUE., .FALSE., .TRUE.,
     $                   3*.FALSE., 5*.TRUE., .FALSE. /
      DATA               LBSIGN / 7*.FALSE., .TRUE., 2*.FALSE.,
     $                   2*.TRUE., 2*.FALSE., .TRUE., .FALSE., .TRUE.,
     $                   9*.FALSE. /
*     ..
*     .. Executable Statements ..
*
*     Check for errors
*
      INFO = 0
*
      BADNN = .FALSE.
      NMAX = 1
      DO 10 J = 1, NSIZES
         NMAX = MAX( NMAX, NN( J ) )
         IF( NN( J ).LT.0 )
     $      BADNN = .TRUE.
   10 CONTINUE
*
      LWKOPT = MAX( 2*NMAX*NMAX, 4*NMAX, 1 )
*
*     Check for errors
*
      IF( NSIZES.LT.0 ) THEN
         INFO = -1
      ELSE IF( BADNN ) THEN
         INFO = -2
      ELSE IF( NTYPES.LT.0 ) THEN
         INFO = -3
      ELSE IF( THRESH.LT.ZERO ) THEN
         INFO = -6
      ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
         INFO = -10
      ELSE IF( LDU.LE.1 .OR. LDU.LT.NMAX ) THEN
         INFO = -19
      ELSE IF( LWKOPT.GT.LWORK ) THEN
         INFO = -30
      END IF
*
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'CCHKGG', -INFO )
         RETURN
      END IF
*
*     Quick return if possible
*
      IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
     $   RETURN
*
      SAFMIN = SLAMCH( 'Safe minimum' )
      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
      SAFMIN = SAFMIN / ULP
      SAFMAX = ONE / SAFMIN
      ULPINV = ONE / ULP
*
*     The values RMAGN(2:3) depend on N, see below.
*
      RMAGN( 0 ) = ZERO
      RMAGN( 1 ) = ONE
*
*     Loop over sizes, types
*
      NTESTT = 0
      NERRS = 0
      NMATS = 0
*
      DO 240 JSIZE = 1, NSIZES
         N = NN( JSIZE )
         N1 = MAX( 1, N )
         RMAGN( 2 ) = SAFMAX*ULP / REAL( N1 )
         RMAGN( 3 ) = SAFMIN*ULPINV*N1
*
         IF( NSIZES.NE.1 ) THEN
            MTYPES = MIN( MAXTYP, NTYPES )
         ELSE
            MTYPES = MIN( MAXTYP+1, NTYPES )
         END IF
*
         DO 230 JTYPE = 1, MTYPES
            IF( .NOT.DOTYPE( JTYPE ) )
     $         GO TO 230
            NMATS = NMATS + 1
            NTEST = 0
*
*           Save ISEED in case of an error.
*
            DO 20 J = 1, 4
               IOLDSD( J ) = ISEED( J )
   20       CONTINUE
*
*           Initialize RESULT
*
            DO 30 J = 1, 15
               RESULT( J ) = ZERO
   30       CONTINUE
*
*           Compute A and B
*
*           Description of control parameters:
*
*           KCLASS: =1 means w/o rotation, =2 means w/ rotation,
*                   =3 means random.
*           KATYPE: the "type" to be passed to CLATM4 for computing A.
*           KAZERO: the pattern of zeros on the diagonal for A:
*                   =1: ( xxx ), =2: (0, xxx ) =3: ( 0, 0, xxx, 0 ),
*                   =4: ( 0, xxx, 0, 0 ), =5: ( 0, 0, 1, xxx, 0 ),
*                   =6: ( 0, 1, 0, xxx, 0 ).  (xxx means a string of
*                   non-zero entries.)
*           KAMAGN: the magnitude of the matrix: =0: zero, =1: O(1),
*                   =2: large, =3: small.
*           LASIGN: .TRUE. if the diagonal elements of A are to be
*                   multiplied by a random magnitude 1 number.
*           KBTYPE, KBZERO, KBMAGN, LBSIGN: the same, but for B.
*           KTRIAN: =0: don't fill in the upper triangle, =1: do.
*           KZ1, KZ2, KADD: used to implement KAZERO and KBZERO.
*           RMAGN:  used to implement KAMAGN and KBMAGN.
*
            IF( MTYPES.GT.MAXTYP )
     $         GO TO 110
            IINFO = 0
            IF( KCLASS( JTYPE ).LT.3 ) THEN
*
*              Generate A (w/o rotation)
*
               IF( ABS( KATYPE( JTYPE ) ).EQ.3 ) THEN
                  IN = 2*( ( N-1 ) / 2 ) + 1
                  IF( IN.NE.N )
     $               CALL CLASET( 'Full', N, N, CZERO, CZERO, A, LDA )
               ELSE
                  IN = N
               END IF
               CALL CLATM4( KATYPE( JTYPE ), IN, KZ1( KAZERO( JTYPE ) ),
     $                      KZ2( KAZERO( JTYPE ) ), LASIGN( JTYPE ),
     $                      RMAGN( KAMAGN( JTYPE ) ), ULP,
     $                      RMAGN( KTRIAN( JTYPE )*KAMAGN( JTYPE ) ), 4,
     $                      ISEED, A, LDA )
               IADD = KADD( KAZERO( JTYPE ) )
               IF( IADD.GT.0 .AND. IADD.LE.N )
     $            A( IADD, IADD ) = RMAGN( KAMAGN( JTYPE ) )
*
*              Generate B (w/o rotation)
*
               IF( ABS( KBTYPE( JTYPE ) ).EQ.3 ) THEN
                  IN = 2*( ( N-1 ) / 2 ) + 1
                  IF( IN.NE.N )
     $               CALL CLASET( 'Full', N, N, CZERO, CZERO, B, LDA )
               ELSE
                  IN = N
               END IF
               CALL CLATM4( KBTYPE( JTYPE ), IN, KZ1( KBZERO( JTYPE ) ),
     $                      KZ2( KBZERO( JTYPE ) ), LBSIGN( JTYPE ),
     $                      RMAGN( KBMAGN( JTYPE ) ), ONE,
     $                      RMAGN( KTRIAN( JTYPE )*KBMAGN( JTYPE ) ), 4,
     $                      ISEED, B, LDA )
               IADD = KADD( KBZERO( JTYPE ) )
               IF( IADD.NE.0 )
     $            B( IADD, IADD ) = RMAGN( KBMAGN( JTYPE ) )
*
               IF( KCLASS( JTYPE ).EQ.2 .AND. N.GT.0 ) THEN
*
*                 Include rotations
*
*                 Generate U, V as Householder transformations times a
*                 diagonal matrix.  (Note that CLARFG makes U(j,j) and
*                 V(j,j) real.)
*
                  DO 50 JC = 1, N - 1
                     DO 40 JR = JC, N
                        U( JR, JC ) = CLARND( 3, ISEED )
                        V( JR, JC ) = CLARND( 3, ISEED )
   40                CONTINUE
                     CALL CLARFG( N+1-JC, U( JC, JC ), U( JC+1, JC ), 1,
     $                            WORK( JC ) )
                     WORK( 2*N+JC ) = SIGN( ONE, REAL( U( JC, JC ) ) )
                     U( JC, JC ) = CONE
                     CALL CLARFG( N+1-JC, V( JC, JC ), V( JC+1, JC ), 1,
     $                            WORK( N+JC ) )
                     WORK( 3*N+JC ) = SIGN( ONE, REAL( V( JC, JC ) ) )
                     V( JC, JC ) = CONE
   50             CONTINUE
                  CTEMP = CLARND( 3, ISEED )
                  U( N, N ) = CONE
                  WORK( N ) = CZERO
                  WORK( 3*N ) = CTEMP / ABS( CTEMP )
                  CTEMP = CLARND( 3, ISEED )
                  V( N, N ) = CONE
                  WORK( 2*N ) = CZERO
                  WORK( 4*N ) = CTEMP / ABS( CTEMP )
*
*                 Apply the diagonal matrices
*
                  DO 70 JC = 1, N
                     DO 60 JR = 1, N
                        A( JR, JC ) = WORK( 2*N+JR )*
     $                                CONJG( WORK( 3*N+JC ) )*
     $                                A( JR, JC )
                        B( JR, JC ) = WORK( 2*N+JR )*
     $                                CONJG( WORK( 3*N+JC ) )*
     $                                B( JR, JC )
   60                CONTINUE
   70             CONTINUE
                  CALL CUNM2R( 'L', 'N', N, N, N-1, U, LDU, WORK, A,
     $                         LDA, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 100
                  CALL CUNM2R( 'R', 'C', N, N, N-1, V, LDU, WORK( N+1 ),
     $                         A, LDA, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 100
                  CALL CUNM2R( 'L', 'N', N, N, N-1, U, LDU, WORK, B,
     $                         LDA, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 100
                  CALL CUNM2R( 'R', 'C', N, N, N-1, V, LDU, WORK( N+1 ),
     $                         B, LDA, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 100
               END IF
            ELSE
*
*              Random matrices
*
               DO 90 JC = 1, N
                  DO 80 JR = 1, N
                     A( JR, JC ) = RMAGN( KAMAGN( JTYPE ) )*
     $                             CLARND( 4, ISEED )
                     B( JR, JC ) = RMAGN( KBMAGN( JTYPE ) )*
     $                             CLARND( 4, ISEED )
   80             CONTINUE
   90          CONTINUE
            END IF
*
            ANORM = CLANGE( '1', N, N, A, LDA, RWORK )
            BNORM = CLANGE( '1', N, N, B, LDA, RWORK )
*
  100       CONTINUE
*
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               RETURN
            END IF
*
  110       CONTINUE
*
*           Call CGEQR2, CUNM2R, and CGGHRD to compute H, T, U, and V
*
            CALL CLACPY( ' ', N, N, A, LDA, H, LDA )
            CALL CLACPY( ' ', N, N, B, LDA, T, LDA )
            NTEST = 1
            RESULT( 1 ) = ULPINV
*
            CALL CGEQR2( N, N, T, LDA, WORK, WORK( N+1 ), IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CGEQR2', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            CALL CUNM2R( 'L', 'C', N, N, N, T, LDA, WORK, H, LDA,
     $                   WORK( N+1 ), IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CUNM2R', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            CALL CLASET( 'Full', N, N, CZERO, CONE, U, LDU )
            CALL CUNM2R( 'R', 'N', N, N, N, T, LDA, WORK, U, LDU,
     $                   WORK( N+1 ), IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CUNM2R', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            CALL CGGHRD( 'V', 'I', N, 1, N, H, LDA, T, LDA, U, LDU, V,
     $                   LDU, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CGGHRD', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
            NTEST = 4
*
*           Do tests 1--4
*
            CALL CGET51( 1, N, A, LDA, H, LDA, U, LDU, V, LDU, WORK,
     $                   RWORK, RESULT( 1 ) )
            CALL CGET51( 1, N, B, LDA, T, LDA, U, LDU, V, LDU, WORK,
     $                   RWORK, RESULT( 2 ) )
            CALL CGET51( 3, N, B, LDA, T, LDA, U, LDU, U, LDU, WORK,
     $                   RWORK, RESULT( 3 ) )
            CALL CGET51( 3, N, B, LDA, T, LDA, V, LDU, V, LDU, WORK,
     $                   RWORK, RESULT( 4 ) )
*
*           Call CHGEQZ to compute S1, P1, S2, P2, Q, and Z, do tests.
*
*           Compute T1 and UZ
*
*           Eigenvalues only
*
            CALL CLACPY( ' ', N, N, H, LDA, S2, LDA )
            CALL CLACPY( ' ', N, N, T, LDA, P2, LDA )
            NTEST = 5
            RESULT( 5 ) = ULPINV
*
            CALL CHGEQZ( 'E', 'N', 'N', N, 1, N, S2, LDA, P2, LDA,
     $                   ALPHA3, BETA3, Q, LDU, Z, LDU, WORK, LWORK,
     $                   RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CHGEQZ(E)', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
*           Eigenvalues and Full Schur Form
*
            CALL CLACPY( ' ', N, N, H, LDA, S2, LDA )
            CALL CLACPY( ' ', N, N, T, LDA, P2, LDA )
*
            CALL CHGEQZ( 'S', 'N', 'N', N, 1, N, S2, LDA, P2, LDA,
     $                   ALPHA1, BETA1, Q, LDU, Z, LDU, WORK, LWORK,
     $                   RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CHGEQZ(S)', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
*           Eigenvalues, Schur Form, and Schur Vectors
*
            CALL CLACPY( ' ', N, N, H, LDA, S1, LDA )
            CALL CLACPY( ' ', N, N, T, LDA, P1, LDA )
*
            CALL CHGEQZ( 'S', 'I', 'I', N, 1, N, S1, LDA, P1, LDA,
     $                   ALPHA1, BETA1, Q, LDU, Z, LDU, WORK, LWORK,
     $                   RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CHGEQZ(V)', IINFO, N, JTYPE,
     $            IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            NTEST = 8
*
*           Do Tests 5--8
*
            CALL CGET51( 1, N, H, LDA, S1, LDA, Q, LDU, Z, LDU, WORK,
     $                   RWORK, RESULT( 5 ) )
            CALL CGET51( 1, N, T, LDA, P1, LDA, Q, LDU, Z, LDU, WORK,
     $                   RWORK, RESULT( 6 ) )
            CALL CGET51( 3, N, T, LDA, P1, LDA, Q, LDU, Q, LDU, WORK,
     $                   RWORK, RESULT( 7 ) )
            CALL CGET51( 3, N, T, LDA, P1, LDA, Z, LDU, Z, LDU, WORK,
     $                   RWORK, RESULT( 8 ) )
*
*           Compute the Left and Right Eigenvectors of (S1,P1)
*
*           9: Compute the left eigenvector Matrix without
*              back transforming:
*
            NTEST = 9
            RESULT( 9 ) = ULPINV
*
*           To test "SELECT" option, compute half of the eigenvectors
*           in one call, and half in another
*
            I1 = N / 2
            DO 120 J = 1, I1
               LLWORK( J ) = .TRUE.
  120       CONTINUE
            DO 130 J = I1 + 1, N
               LLWORK( J ) = .FALSE.
  130       CONTINUE
*
            CALL CTGEVC( 'L', 'S', LLWORK, N, S1, LDA, P1, LDA, EVECTL,
     $                   LDU, CDUMMA, LDU, N, IN, WORK, RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CTGEVC(L,S1)', IINFO, N,
     $            JTYPE, IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            I1 = IN
            DO 140 J = 1, I1
               LLWORK( J ) = .FALSE.
  140       CONTINUE
            DO 150 J = I1 + 1, N
               LLWORK( J ) = .TRUE.
  150       CONTINUE
*
            CALL CTGEVC( 'L', 'S', LLWORK, N, S1, LDA, P1, LDA,
     $                   EVECTL( 1, I1+1 ), LDU, CDUMMA, LDU, N, IN,
     $                   WORK, RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CTGEVC(L,S2)', IINFO, N,
     $            JTYPE, IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            CALL CGET52( .TRUE., N, S1, LDA, P1, LDA, EVECTL, LDU,
     $                   ALPHA1, BETA1, WORK, RWORK, DUMMA( 1 ) )
            RESULT( 9 ) = DUMMA( 1 )
            IF( DUMMA( 2 ).GT.THRSHN ) THEN
               WRITE( NOUNIT, FMT = 9998 )'Left', 'CTGEVC(HOWMNY=S)',
     $            DUMMA( 2 ), N, JTYPE, IOLDSD
            END IF
*
*           10: Compute the left eigenvector Matrix with
*               back transforming:
*
            NTEST = 10
            RESULT( 10 ) = ULPINV
            CALL CLACPY( 'F', N, N, Q, LDU, EVECTL, LDU )
            CALL CTGEVC( 'L', 'B', LLWORK, N, S1, LDA, P1, LDA, EVECTL,
     $                   LDU, CDUMMA, LDU, N, IN, WORK, RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CTGEVC(L,B)', IINFO, N,
     $            JTYPE, IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            CALL CGET52( .TRUE., N, H, LDA, T, LDA, EVECTL, LDU, ALPHA1,
     $                   BETA1, WORK, RWORK, DUMMA( 1 ) )
            RESULT( 10 ) = DUMMA( 1 )
            IF( DUMMA( 2 ).GT.THRSHN ) THEN
               WRITE( NOUNIT, FMT = 9998 )'Left', 'CTGEVC(HOWMNY=B)',
     $            DUMMA( 2 ), N, JTYPE, IOLDSD
            END IF
*
*           11: Compute the right eigenvector Matrix without
*               back transforming:
*
            NTEST = 11
            RESULT( 11 ) = ULPINV
*
*           To test "SELECT" option, compute half of the eigenvectors
*           in one call, and half in another
*
            I1 = N / 2
            DO 160 J = 1, I1
               LLWORK( J ) = .TRUE.
  160       CONTINUE
            DO 170 J = I1 + 1, N
               LLWORK( J ) = .FALSE.
  170       CONTINUE
*
            CALL CTGEVC( 'R', 'S', LLWORK, N, S1, LDA, P1, LDA, CDUMMA,
     $                   LDU, EVECTR, LDU, N, IN, WORK, RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CTGEVC(R,S1)', IINFO, N,
     $            JTYPE, IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            I1 = IN
            DO 180 J = 1, I1
               LLWORK( J ) = .FALSE.
  180       CONTINUE
            DO 190 J = I1 + 1, N
               LLWORK( J ) = .TRUE.
  190       CONTINUE
*
            CALL CTGEVC( 'R', 'S', LLWORK, N, S1, LDA, P1, LDA, CDUMMA,
     $                   LDU, EVECTR( 1, I1+1 ), LDU, N, IN, WORK,
     $                   RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CTGEVC(R,S2)', IINFO, N,
     $            JTYPE, IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            CALL CGET52( .FALSE., N, S1, LDA, P1, LDA, EVECTR, LDU,
     $                   ALPHA1, BETA1, WORK, RWORK, DUMMA( 1 ) )
            RESULT( 11 ) = DUMMA( 1 )
            IF( DUMMA( 2 ).GT.THRESH ) THEN
               WRITE( NOUNIT, FMT = 9998 )'Right', 'CTGEVC(HOWMNY=S)',
     $            DUMMA( 2 ), N, JTYPE, IOLDSD
            END IF
*
*           12: Compute the right eigenvector Matrix with
*               back transforming:
*
            NTEST = 12
            RESULT( 12 ) = ULPINV
            CALL CLACPY( 'F', N, N, Z, LDU, EVECTR, LDU )
            CALL CTGEVC( 'R', 'B', LLWORK, N, S1, LDA, P1, LDA, CDUMMA,
     $                   LDU, EVECTR, LDU, N, IN, WORK, RWORK, IINFO )
            IF( IINFO.NE.0 ) THEN
               WRITE( NOUNIT, FMT = 9999 )'CTGEVC(R,B)', IINFO, N,
     $            JTYPE, IOLDSD
               INFO = ABS( IINFO )
               GO TO 210
            END IF
*
            CALL CGET52( .FALSE., N, H, LDA, T, LDA, EVECTR, LDU,
     $                   ALPHA1, BETA1, WORK, RWORK, DUMMA( 1 ) )
            RESULT( 12 ) = DUMMA( 1 )
            IF( DUMMA( 2 ).GT.THRESH ) THEN
               WRITE( NOUNIT, FMT = 9998 )'Right', 'CTGEVC(HOWMNY=B)',
     $            DUMMA( 2 ), N, JTYPE, IOLDSD
            END IF
*
*           Tests 13--15 are done only on request
*
            IF( TSTDIF ) THEN
*
*              Do Tests 13--14
*
               CALL CGET51( 2, N, S1, LDA, S2, LDA, Q, LDU, Z, LDU,
     $                      WORK, RWORK, RESULT( 13 ) )
               CALL CGET51( 2, N, P1, LDA, P2, LDA, Q, LDU, Z, LDU,
     $                      WORK, RWORK, RESULT( 14 ) )
*
*              Do Test 15
*
               TEMP1 = ZERO
               TEMP2 = ZERO
               DO 200 J = 1, N
                  TEMP1 = MAX( TEMP1, ABS( ALPHA1( J )-ALPHA3( J ) ) )
                  TEMP2 = MAX( TEMP2, ABS( BETA1( J )-BETA3( J ) ) )
  200          CONTINUE
*
               TEMP1 = TEMP1 / MAX( SAFMIN, ULP*MAX( TEMP1, ANORM ) )
               TEMP2 = TEMP2 / MAX( SAFMIN, ULP*MAX( TEMP2, BNORM ) )
               RESULT( 15 ) = MAX( TEMP1, TEMP2 )
               NTEST = 15
            ELSE
               RESULT( 13 ) = ZERO
               RESULT( 14 ) = ZERO
               RESULT( 15 ) = ZERO
               NTEST = 12
            END IF
*
*           End of Loop -- Check for RESULT(j) > THRESH
*
  210       CONTINUE
*
            NTESTT = NTESTT + NTEST
*
*           Print out tests which fail.
*
            DO 220 JR = 1, NTEST
               IF( RESULT( JR ).GE.THRESH ) THEN
*
*                 If this is the first test to fail,
*                 print a header to the data file.
*
                  IF( NERRS.EQ.0 ) THEN
                     WRITE( NOUNIT, FMT = 9997 )'CGG'
*
*                    Matrix types
*
                     WRITE( NOUNIT, FMT = 9996 )
                     WRITE( NOUNIT, FMT = 9995 )
                     WRITE( NOUNIT, FMT = 9994 )'Unitary'
*
*                    Tests performed
*
                     WRITE( NOUNIT, FMT = 9993 )'unitary', '*',
     $                  'conjugate transpose', ( '*', J = 1, 10 )
*
                  END IF
                  NERRS = NERRS + 1
                  IF( RESULT( JR ).LT.10000.0 ) THEN
                     WRITE( NOUNIT, FMT = 9992 )N, JTYPE, IOLDSD, JR,
     $                  RESULT( JR )
                  ELSE
                     WRITE( NOUNIT, FMT = 9991 )N, JTYPE, IOLDSD, JR,
     $                  RESULT( JR )
                  END IF
               END IF
  220       CONTINUE
*
  230    CONTINUE
  240 CONTINUE
*
*     Summary
*
      CALL SLASUM( 'CGG', NOUNIT, NERRS, NTESTT )
      RETURN
*
 9999 FORMAT( ' CCHKGG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
     $      I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
*
 9998 FORMAT( ' CCHKGG: ', A, ' Eigenvectors from ', A, ' incorrectly ',
     $      'normalized.', / ' Bits of error=', 0P, G10.3, ',', 9X,
     $      'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5,
     $      ')' )
*
 9997 FORMAT( 1X, A3, ' -- Complex Generalized eigenvalue problem' )
*
 9996 FORMAT( ' Matrix types (see CCHKGG for details): ' )
*
 9995 FORMAT( ' Special Matrices:', 23X,
     $      '(J''=transposed Jordan block)',
     $      / '   1=(0,0)  2=(I,0)  3=(0,I)  4=(I,I)  5=(J'',J'')  ',
     $      '6=(diag(J'',I), diag(I,J''))', / ' Diagonal Matrices:  ( ',
     $      'D=diag(0,1,2,...) )', / '   7=(D,I)   9=(large*D, small*I',
     $      ')  11=(large*I, small*D)  13=(large*D, large*I)', /
     $      '   8=(I,D)  10=(small*D, large*I)  12=(small*I, large*D) ',
     $      ' 14=(small*D, small*I)', / '  15=(D, reversed D)' )
 9994 FORMAT( ' Matrices Rotated by Random ', A, ' Matrices U, V:',
     $      / '  16=Transposed Jordan Blocks             19=geometric ',
     $      'alpha, beta=0,1', / '  17=arithm. alpha&beta             ',
     $      '      20=arithmetic alpha, beta=0,1', / '  18=clustered ',
     $      'alpha, beta=0,1            21=random alpha, beta=0,1',
     $      / ' Large & Small Matrices:', / '  22=(large, small)   ',
     $      '23=(small,large)    24=(small,small)    25=(large,large)',
     $      / '  26=random O(1) matrices.' )
*
 9993 FORMAT( / ' Tests performed:   (H is Hessenberg, S is Schur, B, ',
     $      'T, P are triangular,', / 20X, 'U, V, Q, and Z are ', A,
     $      ', l and r are the', / 20X,
     $      'appropriate left and right eigenvectors, resp., a is',
     $      / 20X, 'alpha, b is beta, and ', A, ' means ', A, '.)',
     $      / ' 1 = | A - U H V', A,
     $      ' | / ( |A| n ulp )      2 = | B - U T V', A,
     $      ' | / ( |B| n ulp )', / ' 3 = | I - UU', A,
     $      ' | / ( n ulp )             4 = | I - VV', A,
     $      ' | / ( n ulp )', / ' 5 = | H - Q S Z', A,
     $      ' | / ( |H| n ulp )', 6X, '6 = | T - Q P Z', A,
     $      ' | / ( |T| n ulp )', / ' 7 = | I - QQ', A,
     $      ' | / ( n ulp )             8 = | I - ZZ', A,
     $      ' | / ( n ulp )', / ' 9 = max | ( b S - a P )', A,
     $      ' l | / const.  10 = max | ( b H - a T )', A,
     $      ' l | / const.', /
     $      ' 11= max | ( b S - a P ) r | / const.   12 = max | ( b H',
     $      ' - a T ) r | / const.', / 1X )
*
 9992 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
     $      4( I4, ',' ), ' result ', I2, ' is', 0P, F8.2 )
 9991 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=',
     $      4( I4, ',' ), ' result ', I2, ' is', 1P, E10.3 )
*
*     End of CCHKGG
*
      END