mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
101 lines
2.9 KiB
Fortran
101 lines
2.9 KiB
Fortran
*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
|