58
   59
   60
   61
   62
   63
   64      CHARACTER*3        PATH
   65      INTEGER            NUNIT
   66
   67
   68
   69
   70
   71
   72      INTEGER            NMAX
   73      parameter( nmax = 4 )
   74
   75
   76      CHARACTER          EQ
   77      CHARACTER*2        C2
   78      INTEGER            I, INFO, J, N_ERR_BNDS, NPARAMS
   79      REAL               ANRM, RCOND, BERR
   80
   81
   82      INTEGER            IP( NMAX )
   83      REAL               R( NMAX ), R1( NMAX ), R2( NMAX ),
   84     $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
   85     $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
   86      COMPLEX            A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
   87     $                   E( NMAX ), W( 2*NMAX ), X( NMAX )
   88
   89
   90      LOGICAL            LSAMEN
   92
   93
  100
  101
  102      LOGICAL            LERR, OK
  103      CHARACTER*32       SRNAMT
  104      INTEGER            INFOT, NOUT
  105
  106
  107      COMMON             / infoc / infot, nout, ok, lerr
  108      COMMON             / srnamc / srnamt
  109
  110
  111      INTRINSIC          cmplx, real
  112
  113
  114
  115      nout = nunit
  116      WRITE( nout, fmt = * )
  117      c2 = path( 2: 3 )
  118
  119
  120
  121      DO 20 j = 1, nmax
  122         DO 10 i = 1, nmax
  123            a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
  124            af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
  125   10    CONTINUE
  126         b( j ) = 0.e+0
  127         e( j ) = 0.e+0
  128         r1( j ) = 0.e+0
  129         r2( j ) = 0.e+0
  130         w( j ) = 0.e+0
  131         x( j ) = 0.e+0
  132         ip( j ) = j
  133   20 CONTINUE
  134      anrm = 1.0
  135      ok = .true.
  136
  137      IF( 
lsamen( 2, c2, 
'HE' ) ) 
THEN 
  138
  139
  140
  141
  142
  143
  144
  145         srnamt = 'CHETRF'
  146         infot = 1
  147         CALL chetrf( 
'/', 0, a, 1, ip, w, 1, info )
 
  148         CALL chkxer( 
'CHETRF', infot, nout, lerr, ok )
 
  149         infot = 2
  150         CALL chetrf( 
'U', -1, a, 1, ip, w, 1, info )
 
  151         CALL chkxer( 
'CHETRF', infot, nout, lerr, ok )
 
  152         infot = 4
  153         CALL chetrf( 
'U', 2, a, 1, ip, w, 4, info )
 
  154         CALL chkxer( 
'CHETRF', infot, nout, lerr, ok )
 
  155         infot = 7
  156         CALL chetrf( 
'U', 0, a, 1, ip, w, 0, info )
 
  157         CALL chkxer( 
'CHETRF', infot, nout, lerr, ok )
 
  158         infot = 7
  159         CALL chetrf( 
'U', 0, a, 1, ip, w, -2, info )
 
  160         CALL chkxer( 
'CHETRF', infot, nout, lerr, ok )
 
  161
  162
  163
  164         srnamt = 'CHETF2'
  165         infot = 1
  166         CALL chetf2( 
'/', 0, a, 1, ip, info )
 
  167         CALL chkxer( 
'CHETF2', infot, nout, lerr, ok )
 
  168         infot = 2
  169         CALL chetf2( 
'U', -1, a, 1, ip, info )
 
  170         CALL chkxer( 
'CHETF2', infot, nout, lerr, ok )
 
  171         infot = 4
  172         CALL chetf2( 
'U', 2, a, 1, ip, info )
 
  173         CALL chkxer( 
'CHETF2', infot, nout, lerr, ok )
 
  174
  175
  176
  177         srnamt = 'CHETRI'
  178         infot = 1
  179         CALL chetri( 
'/', 0, a, 1, ip, w, info )
 
  180         CALL chkxer( 
'CHETRI', infot, nout, lerr, ok )
 
  181         infot = 2
  182         CALL chetri( 
'U', -1, a, 1, ip, w, info )
 
  183         CALL chkxer( 
'CHETRI', infot, nout, lerr, ok )
 
  184         infot = 4
  185         CALL chetri( 
'U', 2, a, 1, ip, w, info )
 
  186         CALL chkxer( 
'CHETRI', infot, nout, lerr, ok )
 
  187
  188
  189
  190         srnamt = 'CHETRI2'
  191         infot = 1
  192         CALL chetri2( 
'/', 0, a, 1, ip, w, 1, info )
 
  193         CALL chkxer( 
'CHETRI2', infot, nout, lerr, ok )
 
  194         infot = 2
  195         CALL chetri2( 
'U', -1, a, 1, ip, w, 1, info )
 
  196         CALL chkxer( 
'CHETRI2', infot, nout, lerr, ok )
 
  197         infot = 4
  198         CALL chetri2( 
'U', 2, a, 1, ip, w, 1, info )
 
  199         CALL chkxer( 
'CHETRI2', infot, nout, lerr, ok )
 
  200
  201
  202
  203         srnamt = 'CHETRI2X'
  204         infot = 1
  205         CALL chetri2x( 
'/', 0, a, 1, ip, w, 1, info )
 
  206         CALL chkxer( 
'CHETRI2X', infot, nout, lerr, ok )
 
  207         infot = 2
  208         CALL chetri2x( 
'U', -1, a, 1, ip, w, 1, info )
 
  209         CALL chkxer( 
'CHETRI2X', infot, nout, lerr, ok )
 
  210         infot = 4
  211         CALL chetri2x( 
'U', 2, a, 1, ip, w, 1, info )
 
  212         CALL chkxer( 
'CHETRI2X', infot, nout, lerr, ok )
 
  213
  214
  215
  216         srnamt = 'CHETRS'
  217         infot = 1
  218         CALL chetrs( 
'/', 0, 0, a, 1, ip, b, 1, info )
 
  219         CALL chkxer( 
'CHETRS', infot, nout, lerr, ok )
 
  220         infot = 2
  221         CALL chetrs( 
'U', -1, 0, a, 1, ip, b, 1, info )
 
  222         CALL chkxer( 
'CHETRS', infot, nout, lerr, ok )
 
  223         infot = 3
  224         CALL chetrs( 
'U', 0, -1, a, 1, ip, b, 1, info )
 
  225         CALL chkxer( 
'CHETRS', infot, nout, lerr, ok )
 
  226         infot = 5
  227         CALL chetrs( 
'U', 2, 1, a, 1, ip, b, 2, info )
 
  228         CALL chkxer( 
'CHETRS', infot, nout, lerr, ok )
 
  229         infot = 8
  230         CALL chetrs( 
'U', 2, 1, a, 2, ip, b, 1, info )
 
  231         CALL chkxer( 
'CHETRS', infot, nout, lerr, ok )
 
  232
  233
  234
  235         srnamt = 'CHERFS'
  236         infot = 1
  237         CALL cherfs( 
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
 
  238     $                r, info )
  239         CALL chkxer( 
'CHERFS', infot, nout, lerr, ok )
 
  240         infot = 2
  241         CALL cherfs( 
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
 
  242     $                w, r, info )
  243         CALL chkxer( 
'CHERFS', infot, nout, lerr, ok )
 
  244         infot = 3
  245         CALL cherfs( 
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
 
  246     $                w, r, info )
  247         CALL chkxer( 
'CHERFS', infot, nout, lerr, ok )
 
  248         infot = 5
  249         CALL cherfs( 
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
 
  250     $                r, info )
  251         CALL chkxer( 
'CHERFS', infot, nout, lerr, ok )
 
  252         infot = 7
  253         CALL cherfs( 
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
 
  254     $                r, info )
  255         CALL chkxer( 
'CHERFS', infot, nout, lerr, ok )
 
  256         infot = 10
  257         CALL cherfs( 
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
 
  258     $                r, info )
  259         CALL chkxer( 
'CHERFS', infot, nout, lerr, ok )
 
  260         infot = 12
  261         CALL cherfs( 
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
 
  262     $                r, info )
  263         CALL chkxer( 
'CHERFS', infot, nout, lerr, ok )
 
  264
  265
  266
  267         srnamt = 'CHECON'
  268         infot = 1
  269         CALL checon( 
'/', 0, a, 1, ip, anrm, rcond, w, info )
 
  270         CALL chkxer( 
'CHECON', infot, nout, lerr, ok )
 
  271         infot = 2
  272         CALL checon( 
'U', -1, a, 1, ip, anrm, rcond, w, info )
 
  273         CALL chkxer( 
'CHECON', infot, nout, lerr, ok )
 
  274         infot = 4
  275         CALL checon( 
'U', 2, a, 1, ip, anrm, rcond, w, info )
 
  276         CALL chkxer( 
'CHECON', infot, nout, lerr, ok )
 
  277         infot = 6
  278         CALL checon( 
'U', 1, a, 1, ip, -anrm, rcond, w, info )
 
  279         CALL chkxer( 
'CHECON', infot, nout, lerr, ok )
 
  280
  281
  282
  283         n_err_bnds = 3
  284         nparams = 0
  285         srnamt = 'CHERFSX'
  286         infot = 1
  287         CALL cherfsx( 
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
 
  288     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  289     $        params, w, r, info )
  290         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  291         infot = 2
  292         CALL cherfsx( 
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
 
  293     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  294     $        params, w, r, info )
  295         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  296         eq = 'N'
  297         infot = 3
  298         CALL cherfsx( 
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
 
  299     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  300     $        params, w, r, info )
  301         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  302         infot = 4
  303         CALL cherfsx( 
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
 
  304     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  305     $        params, w, r, info )
  306         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  307         infot = 6
  308         CALL cherfsx( 
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
 
  309     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  310     $        params, w, r, info )
  311         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  312         infot = 8
  313         CALL cherfsx( 
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
 
  314     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  315     $        params, w, r, info )
  316         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  317         infot = 12
  318         CALL cherfsx( 
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
 
  319     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  320     $        params, w, r, info )
  321         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  322         infot = 14
  323         CALL cherfsx( 
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
 
  324     $        rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
  325     $        params, w, r, info )
  326         CALL chkxer( 
'CHERFSX', infot, nout, lerr, ok )
 
  327
  328      ELSE IF( 
lsamen( 2, c2, 
'HR' ) ) 
THEN 
  329
  330
  331
  332
  333
  334
  335
  336         srnamt = 'CHETRF_ROOK'
  337         infot = 1
  339         CALL chkxer( 
'CHETRF_ROOK', infot, nout, lerr, ok )
 
  340         infot = 2
  342         CALL chkxer( 
'CHETRF_ROOK', infot, nout, lerr, ok )
 
  343         infot = 4
  345         CALL chkxer( 
'CHETRF_ROOK', infot, nout, lerr, ok )
 
  346         infot = 7
  348         CALL chkxer( 
'CHETRF_ROOK', infot, nout, lerr, ok )
 
  349         infot = 7
  351         CALL chkxer( 
'CHETRF_ROOK', infot, nout, lerr, ok )
 
  352
  353
  354
  355         srnamt = 'CHETF2_ROOK'
  356         infot = 1
  358         CALL chkxer( 
'CHETF2_ROOK', infot, nout, lerr, ok )
 
  359         infot = 2
  361         CALL chkxer( 
'CHETF2_ROOK', infot, nout, lerr, ok )
 
  362         infot = 4
  364         CALL chkxer( 
'CHETF2_ROOK', infot, nout, lerr, ok )
 
  365
  366
  367
  368         srnamt = 'CHETRI_ROOK'
  369         infot = 1
  371         CALL chkxer( 
'CHETRI_ROOK', infot, nout, lerr, ok )
 
  372         infot = 2
  374         CALL chkxer( 
'CHETRI_ROOK', infot, nout, lerr, ok )
 
  375         infot = 4
  377         CALL chkxer( 
'CHETRI_ROOK', infot, nout, lerr, ok )
 
  378
  379
  380
  381         srnamt = 'CHETRS_ROOK'
  382         infot = 1
  383         CALL chetrs_rook( 
'/', 0, 0, a, 1, ip, b, 1, info )
 
  384         CALL chkxer( 
'CHETRS_ROOK', infot, nout, lerr, ok )
 
  385         infot = 2
  386         CALL chetrs_rook( 
'U', -1, 0, a, 1, ip, b, 1, info )
 
  387         CALL chkxer( 
'CHETRS_ROOK', infot, nout, lerr, ok )
 
  388         infot = 3
  389         CALL chetrs_rook( 
'U', 0, -1, a, 1, ip, b, 1, info )
 
  390         CALL chkxer( 
'CHETRS_ROOK', infot, nout, lerr, ok )
 
  391         infot = 5
  392         CALL chetrs_rook( 
'U', 2, 1, a, 1, ip, b, 2, info )
 
  393         CALL chkxer( 
'CHETRS_ROOK', infot, nout, lerr, ok )
 
  394         infot = 8
  395         CALL chetrs_rook( 
'U', 2, 1, a, 2, ip, b, 1, info )
 
  396         CALL chkxer( 
'CHETRS_ROOK', infot, nout, lerr, ok )
 
  397
  398
  399
  400         srnamt = 'CHECON_ROOK'
  401         infot = 1
  402         CALL checon_rook( 
'/', 0, a, 1, ip, anrm, rcond, w, info )
 
  403         CALL chkxer( 
'CHECON_ROOK', infot, nout, lerr, ok )
 
  404         infot = 2
  405         CALL checon_rook( 
'U', -1, a, 1, ip, anrm, rcond, w, info )
 
  406         CALL chkxer( 
'CHECON_ROOK', infot, nout, lerr, ok )
 
  407         infot = 4
  408         CALL checon_rook( 
'U', 2, a, 1, ip, anrm, rcond, w, info )
 
  409         CALL chkxer( 
'CHECON_ROOK', infot, nout, lerr, ok )
 
  410         infot = 6
  411         CALL checon_rook( 
'U', 1, a, 1, ip, -anrm, rcond, w, info )
 
  412         CALL chkxer( 
'CHECON_ROOK', infot, nout, lerr, ok )
 
  413
  414      ELSE IF( 
lsamen( 2, c2, 
'HK' ) ) 
THEN 
  415
  416
  417
  418
  419
  420
  421
  422
  423
  424
  425
  426         srnamt = 'CHETRF_RK'
  427         infot = 1
  428         CALL chetrf_rk( 
'/', 0, a, 1, e, ip, w, 1, info )
 
  429         CALL chkxer( 
'CHETRF_RK', infot, nout, lerr, ok )
 
  430         infot = 2
  431         CALL chetrf_rk( 
'U', -1, a, 1, e, ip, w, 1, info )
 
  432         CALL chkxer( 
'CHETRF_RK', infot, nout, lerr, ok )
 
  433         infot = 4
  434         CALL chetrf_rk( 
'U', 2, a, 1, e, ip, w, 4, info )
 
  435         CALL chkxer( 
'CHETRF_RK', infot, nout, lerr, ok )
 
  436         infot = 8
  437         CALL chetrf_rk( 
'U', 0, a, 1, e, ip, w, 0, info )
 
  438         CALL chkxer( 
'CHETRF_RK', infot, nout, lerr, ok )
 
  439         infot = 8
  440         CALL chetrf_rk( 
'U', 0, a, 1, e, ip, w, -2, info )
 
  441         CALL chkxer( 
'CHETRF_RK', infot, nout, lerr, ok )
 
  442
  443
  444
  445         srnamt = 'CHETF2_RK'
  446         infot = 1
  447         CALL chetf2_rk( 
'/', 0, a, 1, e, ip, info )
 
  448         CALL chkxer( 
'CHETF2_RK', infot, nout, lerr, ok )
 
  449         infot = 2
  450         CALL chetf2_rk( 
'U', -1, a, 1, e, ip, info )
 
  451         CALL chkxer( 
'CHETF2_RK', infot, nout, lerr, ok )
 
  452         infot = 4
  453         CALL chetf2_rk( 
'U', 2, a, 1, e, ip, info )
 
  454         CALL chkxer( 
'CHETF2_RK', infot, nout, lerr, ok )
 
  455
  456
  457
  458         srnamt = 'CHETRI_3'
  459         infot = 1
  460         CALL chetri_3( 
'/', 0, a, 1, e, ip, w, 1, info )
 
  461         CALL chkxer( 
'CHETRI_3', infot, nout, lerr, ok )
 
  462         infot = 2
  463         CALL chetri_3( 
'U', -1, a, 1, e, ip, w, 1, info )
 
  464         CALL chkxer( 
'CHETRI_3', infot, nout, lerr, ok )
 
  465         infot = 4
  466         CALL chetri_3( 
'U', 2, a, 1, e, ip, w, 1, info )
 
  467         CALL chkxer( 
'CHETRI_3', infot, nout, lerr, ok )
 
  468         infot = 8
  469         CALL chetri_3( 
'U', 0, a, 1, e, ip, w, 0, info )
 
  470         CALL chkxer( 
'CHETRI_3', infot, nout, lerr, ok )
 
  471         infot = 8
  472         CALL chetri_3( 
'U', 0, a, 1, e, ip, w, -2, info )
 
  473         CALL chkxer( 
'CHETRI_3', infot, nout, lerr, ok )
 
  474
  475
  476
  477         srnamt = 'CHETRI_3X'
  478         infot = 1
  479         CALL chetri_3x( 
'/', 0, a, 1, e, ip, w, 1, info )
 
  480         CALL chkxer( 
'CHETRI_3X', infot, nout, lerr, ok )
 
  481         infot = 2
  482         CALL chetri_3x( 
'U', -1, a, 1, e, ip, w, 1, info )
 
  483         CALL chkxer( 
'CHETRI_3X', infot, nout, lerr, ok )
 
  484         infot = 4
  485         CALL chetri_3x( 
'U', 2, a, 1, e, ip, w, 1, info )
 
  486         CALL chkxer( 
'CHETRI_3X', infot, nout, lerr, ok )
 
  487
  488
  489
  490         srnamt = 'CHETRS_3'
  491         infot = 1
  492         CALL chetrs_3( 
'/', 0, 0, a, 1, e, ip, b, 1, info )
 
  493         CALL chkxer( 
'CHETRS_3', infot, nout, lerr, ok )
 
  494         infot = 2
  495         CALL chetrs_3( 
'U', -1, 0, a, 1, e, ip, b, 1, info )
 
  496         CALL chkxer( 
'CHETRS_3', infot, nout, lerr, ok )
 
  497         infot = 3
  498         CALL chetrs_3( 
'U', 0, -1, a, 1, e, ip, b, 1, info )
 
  499         CALL chkxer( 
'CHETRS_3', infot, nout, lerr, ok )
 
  500         infot = 5
  501         CALL chetrs_3( 
'U', 2, 1, a, 1, e, ip, b, 2, info )
 
  502         CALL chkxer( 
'CHETRS_3', infot, nout, lerr, ok )
 
  503         infot = 9
  504         CALL chetrs_3( 
'U', 2, 1, a, 2, e, ip, b, 1, info )
 
  505         CALL chkxer( 
'CHETRS_3', infot, nout, lerr, ok )
 
  506
  507
  508
  509         srnamt = 'CHECON_3'
  510         infot = 1
  511         CALL checon_3( 
'/', 0, a, 1,  e, ip, anrm, rcond, w, info )
 
  512         CALL chkxer( 
'CHECON_3', infot, nout, lerr, ok )
 
  513         infot = 2
  514         CALL checon_3( 
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
 
  515         CALL chkxer( 
'CHECON_3', infot, nout, lerr, ok )
 
  516         infot = 4
  517         CALL checon_3( 
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
 
  518         CALL chkxer( 
'CHECON_3', infot, nout, lerr, ok )
 
  519         infot = 7
  520         CALL checon_3( 
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
 
  521         CALL chkxer( 
'CHECON_3', infot, nout, lerr, ok )
 
  522
  523      ELSE IF( 
lsamen( 2, c2, 
'HP' ) ) 
THEN 
  524
  525
  526
  527
  528
  529
  530
  531         srnamt = 'CHPTRF'
  532         infot = 1
  533         CALL chptrf( 
'/', 0, a, ip, info )
 
  534         CALL chkxer( 
'CHPTRF', infot, nout, lerr, ok )
 
  535         infot = 2
  536         CALL chptrf( 
'U', -1, a, ip, info )
 
  537         CALL chkxer( 
'CHPTRF', infot, nout, lerr, ok )
 
  538
  539
  540
  541         srnamt = 'CHPTRI'
  542         infot = 1
  543         CALL chptri( 
'/', 0, a, ip, w, info )
 
  544         CALL chkxer( 
'CHPTRI', infot, nout, lerr, ok )
 
  545         infot = 2
  546         CALL chptri( 
'U', -1, a, ip, w, info )
 
  547         CALL chkxer( 
'CHPTRI', infot, nout, lerr, ok )
 
  548
  549
  550
  551         srnamt = 'CHPTRS'
  552         infot = 1
  553         CALL chptrs( 
'/', 0, 0, a, ip, b, 1, info )
 
  554         CALL chkxer( 
'CHPTRS', infot, nout, lerr, ok )
 
  555         infot = 2
  556         CALL chptrs( 
'U', -1, 0, a, ip, b, 1, info )
 
  557         CALL chkxer( 
'CHPTRS', infot, nout, lerr, ok )
 
  558         infot = 3
  559         CALL chptrs( 
'U', 0, -1, a, ip, b, 1, info )
 
  560         CALL chkxer( 
'CHPTRS', infot, nout, lerr, ok )
 
  561         infot = 7
  562         CALL chptrs( 
'U', 2, 1, a, ip, b, 1, info )
 
  563         CALL chkxer( 
'CHPTRS', infot, nout, lerr, ok )
 
  564
  565
  566
  567         srnamt = 'CHPRFS'
  568         infot = 1
  569         CALL chprfs( 
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
 
  570     $                info )
  571         CALL chkxer( 
'CHPRFS', infot, nout, lerr, ok )
 
  572         infot = 2
  573         CALL chprfs( 
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
 
  574     $                info )
  575         CALL chkxer( 
'CHPRFS', infot, nout, lerr, ok )
 
  576         infot = 3
  577         CALL chprfs( 
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
 
  578     $                info )
  579         CALL chkxer( 
'CHPRFS', infot, nout, lerr, ok )
 
  580         infot = 8
  581         CALL chprfs( 
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
 
  582     $                info )
  583         CALL chkxer( 
'CHPRFS', infot, nout, lerr, ok )
 
  584         infot = 10
  585         CALL chprfs( 
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
 
  586     $                info )
  587         CALL chkxer( 
'CHPRFS', infot, nout, lerr, ok )
 
  588
  589
  590
  591         srnamt = 'CHPCON'
  592         infot = 1
  593         CALL chpcon( 
'/', 0, a, ip, anrm, rcond, w, info )
 
  594         CALL chkxer( 
'CHPCON', infot, nout, lerr, ok )
 
  595         infot = 2
  596         CALL chpcon( 
'U', -1, a, ip, anrm, rcond, w, info )
 
  597         CALL chkxer( 
'CHPCON', infot, nout, lerr, ok )
 
  598         infot = 5
  599         CALL chpcon( 
'U', 1, a, ip, -anrm, rcond, w, info )
 
  600         CALL chkxer( 
'CHPCON', infot, nout, lerr, ok )
 
  601      END IF
  602
  603
  604
  605      CALL alaesm( path, ok, nout )
 
  606
  607      RETURN
  608
  609
  610
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine checon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, info)
CHECON_3
subroutine checon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
subroutine checon(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
CHECON
subroutine cherfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CHERFS
subroutine cherfsx(uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork, info)
CHERFSX
subroutine chetf2_rk(uplo, n, a, lda, e, ipiv, info)
CHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
subroutine chetf2_rook(uplo, n, a, lda, ipiv, info)
CHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine chetf2(uplo, n, a, lda, ipiv, info)
CHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
subroutine chetrf_rk(uplo, n, a, lda, e, ipiv, work, lwork, info)
CHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
subroutine chetrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine chetrf(uplo, n, a, lda, ipiv, work, lwork, info)
CHETRF
subroutine chetri2(uplo, n, a, lda, ipiv, work, lwork, info)
CHETRI2
subroutine chetri2x(uplo, n, a, lda, ipiv, work, nb, info)
CHETRI2X
subroutine chetri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
CHETRI_3
subroutine chetri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
CHETRI_3X
subroutine chetri_rook(uplo, n, a, lda, ipiv, work, info)
CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine chetri(uplo, n, a, lda, ipiv, work, info)
CHETRI
subroutine chetrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
CHETRS_3
subroutine chetrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
subroutine chetrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CHETRS
subroutine chpcon(uplo, n, ap, ipiv, anorm, rcond, work, info)
CHPCON
subroutine chprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CHPRFS
subroutine chptrf(uplo, n, ap, ipiv, info)
CHPTRF
subroutine chptri(uplo, n, ap, ipiv, work, info)
CHPTRI
subroutine chptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
CHPTRS
logical function lsamen(n, ca, cb)
LSAMEN