Download lsame.eso

Back to the list

   1 : C LSAME     SOURCE    CHAT      05/01/13    01:25:23     5004           
   2 :       FUNCTION LSAME( CA, CB )
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : *     
   6 : *  -- LAPACK auxiliary routine (version 2.0) --
   7 : *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
   8 : *     Courant Institute, Argonne National Lab, and Rice University
   9 : *     January 31, 1994
  10 : *     Modified on 16/2/98 :  commented INTRINSIC (not esope compatible)
  11 : *     
  12 : *     .. Scalar Result ..
  13 :       LOGICAL LSAME
  14 : *     .. Scalar Arguments ..
  15 :       CHARACTER*1     CA, CB
  16 : *     ..
  17 : *     
  18 : *  Purpose
  19 : *  =======
  20 : *     
  21 : *  LSAME returns .TRUE. if CA is the same letter as CB regardless of
  22 : *  case.
  23 : *     
  24 : *  Arguments
  25 : *  =========
  26 : *     
  27 : *  CA      (input) CHARACTER*1
  28 : *  CB      (input) CHARACTER*1
  29 : *          CA and CB specify the single characters to be compared.
  30 : *     
  31 : * =====================================================================
  32 : *     
  33 : *     .. Intrinsic Functions ..
  34 : *      INTRINSIC          ICHAR
  35 : *     ..
  36 : *     .. Local Scalars ..
  37 :       INTEGER            INTA, INTB, ZCODE
  38 : *     ..
  39 : *     .. Executable Statements ..
  40 : *     
  41 : *     Test if the characters are equal
  42 : *     
  43 :       LSAME = CA.EQ.CB
  44 :       IF( LSAME )
  45 :      $     RETURN
  46 : *     
  47 : *     Now test for equivalence if both characters are alphabetic.
  48 : *     
  49 :       ZCODE = ICHAR( 'Z' )
  50 : *     
  51 : *     Use 'Z' rather than 'A' so that ASCII can be detected on Prime
  52 : *     machines, on which ICHAR returns a value with bit 8 set.
  53 : *     ICHAR('A') on Prime machines returns 193 which is the same as
  54 : *     ICHAR('A') on an EBCDIC machine.
  55 : *     
  56 :       INTA = ICHAR( CA )
  57 :       INTB = ICHAR( CB )
  58 : *     
  59 :       IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN
  60 : *     
  61 : *        ASCII is assumed - ZCODE is the ASCII code of either lower or
  62 : *        upper case 'Z'.
  63 : *     
  64 :          IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32
  65 :          IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32
  66 : *     
  67 :       ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN
  68 : *     
  69 : *        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
  70 : *        upper case 'Z'.
  71 : *     
  72 :          IF( INTA.GE.129 .AND. INTA.LE.137 .OR.
  73 :      $        INTA.GE.145 .AND. INTA.LE.153 .OR.
  74 :      $        INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64
  75 :          IF( INTB.GE.129 .AND. INTB.LE.137 .OR.
  76 :      $        INTB.GE.145 .AND. INTB.LE.153 .OR.
  77 :      $        INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64
  78 : *     
  79 :       ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN
  80 : *     
  81 : *        ASCII is assumed, on Prime machines - ZCODE is the ASCII code
  82 : *        plus 128 of either lower or upper case 'Z'.
  83 : *     
  84 :          IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32
  85 :          IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32
  86 :       END IF
  87 :       LSAME = INTA.EQ.INTB
  88 : *     
  89 :       RETURN
  90 : *     
  91 : *     End of LSAME
  92 : *     
  93 :       END
  94 : 
  95 : 
  96 :  
  97 :  

© Cast3M 2003 - All rights reserved.
Disclaimer