vendor/gonum.org/v1/gonum/lapack/internal/testdata/dlasqtest/lsame.f

   1 *> \brief \b LSAME
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *      LOGICAL FUNCTION LSAME( CA, CB )
  12 *
  13 *     .. Scalar Arguments ..
  14 *      CHARACTER          CA, CB
  15 *     ..
  16 *
  17 *
  18 *> \par Purpose:
  19 *  =============
  20 *>
  21 *> \verbatim
  22 *>
  23 *> LSAME returns .TRUE. if CA is the same letter as CB regardless of
  24 *> case.
  25 *> \endverbatim
  26 *
  27 *  Arguments:
  28 *  ==========
  29 *
  30 *> \param[in] CA
  31 *> \verbatim
  32 *> \endverbatim
  33 *>
  34 *> \param[in] CB
  35 *> \verbatim
  36 *>          CA and CB specify the single characters to be compared.
  37 *> \endverbatim
  38 *
  39 *  Authors:
  40 *  ========
  41 *
  42 *> \author Univ. of Tennessee
  43 *> \author Univ. of California Berkeley
  44 *> \author Univ. of Colorado Denver
  45 *> \author NAG Ltd.
  46 *
  47 *> \date November 2011
  48 *
  49 *> \ingroup auxOTHERauxiliary
  50 *
  51 *  =====================================================================
  52       LOGICAL FUNCTION LSAME( CA, CB )
  53 *
  54 *  -- LAPACK auxiliary routine (version 3.4.0) --
  55 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  56 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  57 *     November 2011
  58 *
  59 *     .. Scalar Arguments ..
  60       CHARACTER          CA, CB
  61 *     ..
  62 *
  63 * =====================================================================
  64 *
  65 *     .. Intrinsic Functions ..
  66       INTRINSIC          ICHAR
  67 *     ..
  68 *     .. Local Scalars ..
  69       INTEGER            INTA, INTB, ZCODE
  70 *     ..
  71 *     .. Executable Statements ..
  72 *
  73 *     Test if the characters are equal
  74 *
  75       LSAME = CA.EQ.CB
  76       IF( LSAME )
  77      $   RETURN
  78 *
  79 *     Now test for equivalence if both characters are alphabetic.
  80 *
  81       ZCODE = ICHAR( 'Z' )
  82 *
  83 *     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
  84 *     machines, on which ICHAR returns a value with bit 8 set.
  85 *     ICHAR('A') on Prime machines returns 193 which is the same as
  86 *     ICHAR('A') on an EBCDIC machine.
  87 *
  88       INTA = ICHAR( CA )
  89       INTB = ICHAR( CB )
  90 *
  91       IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
  92 *
  93 *        ASCII is assumed - ZCODE is the ASCII code of either lower or
  94 *        upper case 'Z'.
  95 *
  96          IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
  97          IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
  98 *
  99       ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
 100 *
 101 *        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
 102 *        upper case 'Z'.
 103 *
 104          IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
 105      $       INTA.GE.145 .AND. INTA.LE.153 .OR.
 106      $       INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
 107          IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
 108      $       INTB.GE.145 .AND. INTB.LE.153 .OR.
 109      $       INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
 110 *
 111       ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
 112 *
 113 *        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
 114 *        plus 128 of either lower or upper case 'Z'.
 115 *
 116          IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
 117          IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
 118       END IF
 119       LSAME = INTA.EQ.INTB
 120 *
 121 *     RETURN
 122 *
 123 *     End of LSAME
 124 *
 125       END