relibc_openlibm/slatec/lsame.f

*DECK LSAME
      LOGICAL FUNCTION LSAME (CA, CB)
C***BEGIN PROLOGUE  LSAME
C***SUBSIDIARY
C***PURPOSE  Test two characters to determine if they are the same
C            letter, except for case.
C***LIBRARY   SLATEC
C***CATEGORY  R, N3
C***TYPE      LOGICAL (LSAME-L)
C***KEYWORDS  CHARACTER COMPARISON, LEVEL 2 BLAS, LEVEL 3 BLAS
C***AUTHOR  Hanson, R., (SNLA)
C           Du Croz, J., (NAG)
C***DESCRIPTION
C
C  LSAME  tests if CA is the same letter as CB regardless of case.
C  CB is assumed to be an upper case letter. LSAME returns .TRUE. if
C  CA is either the same as CB or the equivalent lower case letter.
C
C  N.B. This version of the code is correct for both ASCII and EBCDIC
C       systems.  Installers must modify the routine for other
C       character-codes.
C
C       For CDC systems using 6-12 bit representations, the system-
C       specific code in comments must be activated.
C
C  Parameters
C  ==========
C
C  CA     - CHARACTER*1
C  CB     - CHARACTER*1
C           On entry, CA and CB specify characters to be compared.
C           Unchanged on exit.
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   860720  DATE WRITTEN
C   910606  Modified to meet SLATEC prologue standards.  Only comment
C           lines were modified.  (BKS)
C   910607  Modified to handle ASCII and EBCDIC codes.  (WRB)
C   930201  Tests for equality and equivalence combined.  (RWC and WRB)
C***END PROLOGUE  LSAME
C     .. Scalar Arguments ..
      CHARACTER CA*1, CB*1
C     .. Local Scalars ..
      INTEGER IOFF
      LOGICAL FIRST
C     .. Intrinsic Functions ..
      INTRINSIC ICHAR
C     .. Save statement ..
      SAVE FIRST, IOFF
C     .. Data statements ..
      DATA FIRST /.TRUE./
C***FIRST EXECUTABLE STATEMENT  LSAME
      IF (FIRST) IOFF = ICHAR('a') - ICHAR('A')
C
      FIRST = .FALSE.
C
C     Test if the characters are equal or equivalent.
C
      LSAME = (CA.EQ.CB) .OR. (ICHAR(CA)-IOFF.EQ.ICHAR(CB))
C
      RETURN
C
C  The following comments contain code for CDC systems using 6-12 bit
C  representations.
C
C     .. Parameters ..
C     INTEGER                ICIRFX
C     PARAMETER            ( ICIRFX=62 )
C     .. Scalar Arguments ..
C     CHARACTER*1            CB
C     .. Array Arguments ..
C     CHARACTER*1            CA(*)
C     .. Local Scalars ..
C     INTEGER                IVAL
C     .. Intrinsic Functions ..
C     INTRINSIC              ICHAR, CHAR
C     .. Executable Statements ..
C     INTRINSIC              ICHAR, CHAR
C
C     See if the first character in string CA equals string CB.
C
C     LSAME = CA(1) .EQ. CB .AND. CA(1) .NE. CHAR(ICIRFX)
C
C     IF (LSAME) RETURN
C
C     The characters are not identical. Now check them for equivalence.
C     Look for the 'escape' character, circumflex, followed by the
C     letter.
C
C     IVAL = ICHAR(CA(2))
C     IF (IVAL.GE.ICHAR('A') .AND. IVAL.LE.ICHAR('Z')) THEN
C        LSAME = CA(1) .EQ. CHAR(ICIRFX) .AND. CA(2) .EQ. CB
C     ENDIF
C
C     RETURN
C
C     End of LSAME.
C
      END