"Fossies" - the Fresh Open Source Software Archive

Member "lapack-3.9.1/TESTING/EIG/alahdg.f" (25 Mar 2021, 10799 Bytes) of package /linux/misc/lapack-3.9.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Fortran 77 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "alahdg.f": 3.9.0_vs_3.9.1.

    1 *> \brief \b ALAHDG
    2 *
    3 *  =========== DOCUMENTATION ===========
    4 *
    5 * Online html documentation available at
    6 *            http://www.netlib.org/lapack/explore-html/
    7 *
    8 *  Definition:
    9 *  ===========
   10 *
   11 *       SUBROUTINE ALAHDG( IOUNIT, PATH )
   12 *
   13 *       .. Scalar Arguments ..
   14 *       CHARACTER*3       PATH
   15 *       INTEGER           IOUNIT
   16 *       ..
   17 *
   18 *
   19 *> \par Purpose:
   20 *  =============
   21 *>
   22 *> \verbatim
   23 *>
   24 *> ALAHDG prints header information for the different test paths.
   25 *> \endverbatim
   26 *
   27 *  Arguments:
   28 *  ==========
   29 *
   30 *> \param[in] IOUNIT
   31 *> \verbatim
   32 *>          IOUNIT is INTEGER
   33 *>          The unit number to which the header information should be
   34 *>          printed.
   35 *> \endverbatim
   36 *>
   37 *> \param[in] PATH
   38 *> \verbatim
   39 *>          PATH is CHARACTER*3
   40 *>          The name of the path for which the header information is to
   41 *>          be printed.  Current paths are
   42 *>             GQR:  GQR (general matrices)
   43 *>             GRQ:  GRQ (general matrices)
   44 *>             LSE:  LSE Problem
   45 *>             GLM:  GLM Problem
   46 *>             GSV:  Generalized Singular Value Decomposition
   47 *>             CSD:  CS Decomposition
   48 *> \endverbatim
   49 *
   50 *  Authors:
   51 *  ========
   52 *
   53 *> \author Univ. of Tennessee
   54 *> \author Univ. of California Berkeley
   55 *> \author Univ. of Colorado Denver
   56 *> \author NAG Ltd.
   57 *
   58 *> \ingroup aux_eig
   59 *
   60 *  =====================================================================
   61       SUBROUTINE ALAHDG( IOUNIT, PATH )
   62 *
   63 *  -- LAPACK test routine --
   64 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
   65 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
   66 *
   67 *     .. Scalar Arguments ..
   68       CHARACTER*3       PATH
   69       INTEGER           IOUNIT
   70 *     ..
   71 *
   72 *  =====================================================================
   73 *
   74 *     .. Local Scalars ..
   75       CHARACTER*3       C2
   76       INTEGER           ITYPE
   77 *     ..
   78 *     .. External Functions ..
   79       LOGICAL           LSAMEN
   80       EXTERNAL          LSAMEN
   81 *     ..
   82 *     .. Executable Statements ..
   83 *
   84       IF( IOUNIT.LE.0 )
   85      $   RETURN
   86       C2 = PATH( 1: 3 )
   87 *
   88 *     First line describing matrices in this path
   89 *
   90       IF( LSAMEN( 3, C2, 'GQR' ) ) THEN
   91          ITYPE = 1
   92          WRITE( IOUNIT, FMT = 9991 )PATH
   93       ELSE IF( LSAMEN( 3, C2, 'GRQ' ) ) THEN
   94          ITYPE = 2
   95          WRITE( IOUNIT, FMT = 9992 )PATH
   96       ELSE IF( LSAMEN( 3, C2, 'LSE' ) ) THEN
   97          ITYPE = 3
   98          WRITE( IOUNIT, FMT = 9993 )PATH
   99       ELSE IF( LSAMEN( 3, C2, 'GLM' ) ) THEN
  100          ITYPE = 4
  101          WRITE( IOUNIT, FMT = 9994 )PATH
  102       ELSE IF( LSAMEN( 3, C2, 'GSV' ) ) THEN
  103          ITYPE = 5
  104          WRITE( IOUNIT, FMT = 9995 )PATH
  105       ELSE IF( LSAMEN( 3, C2, 'CSD' ) ) THEN
  106          ITYPE = 6
  107          WRITE( IOUNIT, FMT = 9996 )PATH
  108       END IF
  109 *
  110 *     Matrix types
  111 *
  112       WRITE( IOUNIT, FMT = 9999 )'Matrix types: '
  113 *
  114       IF( ITYPE.EQ.1 )THEN
  115          WRITE( IOUNIT, FMT = 9950 )1
  116          WRITE( IOUNIT, FMT = 9952 )2
  117          WRITE( IOUNIT, FMT = 9954 )3
  118          WRITE( IOUNIT, FMT = 9955 )4
  119          WRITE( IOUNIT, FMT = 9956 )5
  120          WRITE( IOUNIT, FMT = 9957 )6
  121          WRITE( IOUNIT, FMT = 9961 )7
  122          WRITE( IOUNIT, FMT = 9962 )8
  123       ELSE IF( ITYPE.EQ.2 )THEN
  124          WRITE( IOUNIT, FMT = 9951 )1
  125          WRITE( IOUNIT, FMT = 9953 )2
  126          WRITE( IOUNIT, FMT = 9954 )3
  127          WRITE( IOUNIT, FMT = 9955 )4
  128          WRITE( IOUNIT, FMT = 9956 )5
  129          WRITE( IOUNIT, FMT = 9957 )6
  130          WRITE( IOUNIT, FMT = 9961 )7
  131          WRITE( IOUNIT, FMT = 9962 )8
  132       ELSE IF( ITYPE.EQ.3 )THEN
  133          WRITE( IOUNIT, FMT = 9950 )1
  134          WRITE( IOUNIT, FMT = 9952 )2
  135          WRITE( IOUNIT, FMT = 9954 )3
  136          WRITE( IOUNIT, FMT = 9955 )4
  137          WRITE( IOUNIT, FMT = 9955 )5
  138          WRITE( IOUNIT, FMT = 9955 )6
  139          WRITE( IOUNIT, FMT = 9955 )7
  140          WRITE( IOUNIT, FMT = 9955 )8
  141       ELSE IF( ITYPE.EQ.4 )THEN
  142          WRITE( IOUNIT, FMT = 9951 )1
  143          WRITE( IOUNIT, FMT = 9953 )2
  144          WRITE( IOUNIT, FMT = 9954 )3
  145          WRITE( IOUNIT, FMT = 9955 )4
  146          WRITE( IOUNIT, FMT = 9955 )5
  147          WRITE( IOUNIT, FMT = 9955 )6
  148          WRITE( IOUNIT, FMT = 9955 )7
  149          WRITE( IOUNIT, FMT = 9955 )8
  150       ELSE IF( ITYPE.EQ.5 )THEN
  151          WRITE( IOUNIT, FMT = 9950 )1
  152          WRITE( IOUNIT, FMT = 9952 )2
  153          WRITE( IOUNIT, FMT = 9954 )3
  154          WRITE( IOUNIT, FMT = 9955 )4
  155          WRITE( IOUNIT, FMT = 9956 )5
  156          WRITE( IOUNIT, FMT = 9957 )6
  157          WRITE( IOUNIT, FMT = 9959 )7
  158          WRITE( IOUNIT, FMT = 9960 )8
  159       ELSE IF( ITYPE.EQ.6 )THEN
  160          WRITE( IOUNIT, FMT = 9963 )1
  161          WRITE( IOUNIT, FMT = 9964 )2
  162          WRITE( IOUNIT, FMT = 9965 )3
  163       END IF
  164 *
  165 *     Tests performed
  166 *
  167       WRITE( IOUNIT, FMT = 9999 )'Test ratios: '
  168 *
  169       IF( ITYPE.EQ.1 ) THEN
  170 *
  171 *        GQR decomposition of rectangular matrices
  172 *
  173          WRITE( IOUNIT, FMT = 9930 )1
  174          WRITE( IOUNIT, FMT = 9931 )2
  175          WRITE( IOUNIT, FMT = 9932 )3
  176          WRITE( IOUNIT, FMT = 9933 )4
  177       ELSE IF( ITYPE.EQ.2 ) THEN
  178 *
  179 *        GRQ decomposition of rectangular matrices
  180 *
  181          WRITE( IOUNIT, FMT = 9934 )1
  182          WRITE( IOUNIT, FMT = 9935 )2
  183          WRITE( IOUNIT, FMT = 9932 )3
  184          WRITE( IOUNIT, FMT = 9933 )4
  185       ELSE IF( ITYPE.EQ.3 ) THEN
  186 *
  187 *        LSE Problem
  188 *
  189          WRITE( IOUNIT, FMT = 9937 )1
  190          WRITE( IOUNIT, FMT = 9938 )2
  191       ELSE IF( ITYPE.EQ.4 ) THEN
  192 *
  193 *        GLM Problem
  194 *
  195          WRITE( IOUNIT, FMT = 9939 )1
  196       ELSE IF( ITYPE.EQ.5 ) THEN
  197 *
  198 *        GSVD
  199 *
  200          WRITE( IOUNIT, FMT = 9940 )1
  201          WRITE( IOUNIT, FMT = 9941 )2
  202          WRITE( IOUNIT, FMT = 9942 )3
  203          WRITE( IOUNIT, FMT = 9943 )4
  204          WRITE( IOUNIT, FMT = 9944 )5
  205       ELSE IF( ITYPE.EQ.6 ) THEN
  206 *
  207 *        CSD
  208 *
  209          WRITE( IOUNIT, FMT = 9910 )
  210          WRITE( IOUNIT, FMT = 9911 )1
  211          WRITE( IOUNIT, FMT = 9912 )2
  212          WRITE( IOUNIT, FMT = 9913 )3
  213          WRITE( IOUNIT, FMT = 9914 )4
  214          WRITE( IOUNIT, FMT = 9915 )5
  215          WRITE( IOUNIT, FMT = 9916 )6
  216          WRITE( IOUNIT, FMT = 9917 )7
  217          WRITE( IOUNIT, FMT = 9918 )8
  218          WRITE( IOUNIT, FMT = 9919 )9
  219          WRITE( IOUNIT, FMT = 9920 )
  220          WRITE( IOUNIT, FMT = 9921 )10
  221          WRITE( IOUNIT, FMT = 9922 )11
  222          WRITE( IOUNIT, FMT = 9923 )12
  223          WRITE( IOUNIT, FMT = 9924 )13
  224          WRITE( IOUNIT, FMT = 9925 )14
  225          WRITE( IOUNIT, FMT = 9926 )15
  226       END IF
  227 *
  228  9999 FORMAT( 1X, A )
  229  9991 FORMAT( / 1X, A3, ': GQR factorization of general matrices' )
  230  9992 FORMAT( / 1X, A3, ': GRQ factorization of general matrices' )
  231  9993 FORMAT( / 1X, A3, ': LSE Problem' )
  232  9994 FORMAT( / 1X, A3, ': GLM Problem' )
  233  9995 FORMAT( / 1X, A3, ': Generalized Singular Value Decomposition' )
  234  9996 FORMAT( / 1X, A3, ': CS Decomposition' )
  235 *
  236  9950 FORMAT( 3X, I2, ': A-diagonal matrix  B-upper triangular' )
  237  9951 FORMAT( 3X, I2, ': A-diagonal matrix  B-lower triangular' )
  238  9952 FORMAT( 3X, I2, ': A-upper triangular B-upper triangular' )
  239  9953 FORMAT( 3X, I2, ': A-lower triangular B-diagonal triangular' )
  240  9954 FORMAT( 3X, I2, ': A-lower triangular B-upper triangular' )
  241 *
  242  9955 FORMAT( 3X, I2, ': Random matrices cond(A)=100, cond(B)=10,' )
  243 *
  244  9956 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
  245      $      'cond(B)= sqrt( 0.1/EPS )' )
  246  9957 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ',
  247      $      'cond(B)= 0.1/EPS' )
  248  9959 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
  249      $      'cond(B)=  0.1/EPS ' )
  250  9960 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ',
  251      $      'cond(B)=  sqrt( 0.1/EPS )' )
  252 *
  253  9961 FORMAT( 3X, I2, ': Matrix scaled near underflow limit' )
  254  9962 FORMAT( 3X, I2, ': Matrix scaled near overflow limit' )
  255  9963 FORMAT( 3X, I2, ': Random orthogonal matrix (Haar measure)' )
  256  9964 FORMAT( 3X, I2, ': Nearly orthogonal matrix with uniformly ',
  257      $      'distributed angles atan2( S, C ) in CS decomposition' )
  258  9965 FORMAT( 3X, I2, ': Random orthogonal matrix with clustered ',
  259      $      'angles atan2( S, C ) in CS decomposition' )
  260 *
  261 *
  262 *     GQR test ratio
  263 *
  264  9930 FORMAT( 3X, I2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )',
  265      $       '* EPS )' )
  266  9931 FORMAT( 3X, I2, ': norm( T * Z - Q'' * B )  / ( min(P,N)*norm(B)',
  267      $       '* EPS )' )
  268  9932 FORMAT( 3X, I2, ': norm( I - Q''*Q )   / ( N * EPS )' )
  269  9933 FORMAT( 3X, I2, ': norm( I - Z''*Z )   / ( P * EPS )' )
  270 *
  271 *     GRQ test ratio
  272 *
  273  9934 FORMAT( 3X, I2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ',
  274      $       'EPS )' )
  275  9935 FORMAT( 3X, I2, ': norm( T * Q - Z'' * B )  / ( min( P,N ) * nor',
  276      $       'm(B)*EPS )' )
  277 *
  278 *     LSE test ratio
  279 *
  280  9937 FORMAT( 3X, I2, ': norm( A*x - c )  / ( norm(A)*norm(x) * EPS )' )
  281  9938 FORMAT( 3X, I2, ': norm( B*x - d )  / ( norm(B)*norm(x) * EPS )' )
  282 *
  283 *     GLM test ratio
  284 *
  285  9939 FORMAT( 3X, I2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*',
  286      $       '(norm(x)+norm(y))*EPS )' )
  287 *
  288 *     GSVD test ratio
  289 *
  290  9940 FORMAT( 3X, I2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*',
  291      $       'norm( A ) * EPS )' )
  292  9941 FORMAT( 3X, I2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*',
  293      $       'norm( B ) * EPS )' )
  294  9942 FORMAT( 3X, I2, ': norm( I - U''*U )   / ( M * EPS )' )
  295  9943 FORMAT( 3X, I2, ': norm( I - V''*V )   / ( P * EPS )' )
  296  9944 FORMAT( 3X, I2, ': norm( I - Q''*Q )   / ( N * EPS )' )
  297 *
  298 *     CSD test ratio
  299 *
  300  9910 FORMAT( 3X, '2-by-2 CSD' )
  301  9911 FORMAT( 3X, I2, ': norm( U1'' * X11 * V1 - C ) / ( max(  P,  Q)',
  302      $       ' * max(norm(I-X''*X),EPS) )' )
  303  9912 FORMAT( 3X, I2, ': norm( U1'' * X12 * V2-(-S)) / ( max(  P,',
  304      $       'M-Q) * max(norm(I-X''*X),EPS) )' )
  305  9913 FORMAT( 3X, I2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,',
  306      $       '  Q) * max(norm(I-X''*X),EPS) )' )
  307  9914 FORMAT( 3X, I2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,',
  308      $       'M-Q) * max(norm(I-X''*X),EPS) )' )
  309  9915 FORMAT( 3X, I2, ': norm( I - U1''*U1 ) / (   P   * EPS )' )
  310  9916 FORMAT( 3X, I2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
  311  9917 FORMAT( 3X, I2, ': norm( I - V1''*V1 ) / (   Q   * EPS )' )
  312  9918 FORMAT( 3X, I2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' )
  313  9919 FORMAT( 3X, I2, ': principal angle ordering ( 0 or ULP )' )
  314  9920 FORMAT( 3X, '2-by-1 CSD' )
  315  9921 FORMAT( 3X, I2, ': norm( U1'' * X11 * V1 - C ) / ( max(  P,  Q)',
  316      $       ' * max(norm(I-X''*X),EPS) )' )
  317  9922 FORMAT( 3X, I2, ': norm( U2'' * X21 * V1 - S ) / ( max(  M-P,',
  318      $       'Q) * max(norm(I-X''*X),EPS) )' )
  319  9923 FORMAT( 3X, I2, ': norm( I - U1''*U1 ) / (   P   * EPS )' )
  320  9924 FORMAT( 3X, I2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
  321  9925 FORMAT( 3X, I2, ': norm( I - V1''*V1 ) / (   Q   * EPS )' )
  322  9926 FORMAT( 3X, I2, ': principal angle ordering ( 0 or ULP )' )
  323       RETURN
  324 *
  325 *     End of ALAHDG
  326 *
  327       END