trunk/blas/lsame.f

      LOGICAL FUNCTION LSAME ( CA, CB )
*     .. Scalar Arguments  ..
      CHARACTER*1       CA,  CB
*     ..
*  Purpose
*  =======
*
*  LSAME  tests if CA is the same letter as CB regardless of case.
*
*  N.B.  This version of the routine is only correct for ASCII code.
*        Installers must modify the routine for other character-codes.
*
*        For EBCDIC systems the constant IOFF must be changed to -64.
*        For CDC system using 6-12 bit representations, the system-
*        specific code in comments must be activated.
*
*  Parameters
*  ==========
*
*  CA    - CHARACTER*1
*  CB    - CHARACTER*1
*          On entry, CA and CB specify characters to be compared.
*          Unchanged on exit.
*
*
*  Auxiliary routine for Level 2 Blas.
*
*  -- Written on 11-October-1988.
*     Richard Hanson, Sandia National Labs.
*     Jeremy Du Croz, Nag Central Office.
*
*     .. Parameters ..
      INTEGER           IOFF
      PARAMETER       ( IOFF = 32 )
*     .. Intrinsic Functions ..
      INTRINSIC         ICHAR
*     .. Executable Statements ..
*
*     Test if the characters are equal
*
      LSAME = CA .EQ. CB
*
*     Now test for equivalence
*
      IF ( .NOT. LSAME ) THEN
     LSAME = ICHAR( CA) - IOFF .EQ. ICHAR( CB)
      END IF
      IF ( .NOT. LSAME ) THEN
     LSAME = ICHAR( CA) .EQ. ICHAR( CB) - IOFF 
      END IF
*
      RETURN
*
*  The following comments contain code for CDC systems using 6-12 bit
*  representations.
*
*     .. Parameters ..
C     INTEGER           ICIRFX
C     PARAMETER       ( ICIRFX = 62 )
*     .. Scalar Arguments ..
C     CHARACTER*1       CB
*     .. Array Arguments ..
C     CHARACTER*1       CA(*)
*     .. Local Scalars ..
C     INTEGER           IVAL
*     .. Intrinsic Functions ..
C     INTRINSIC         ICHAR,  CHAR
*     .. Executable Statements ..
*
*     See if the first character in string CA equals string CB.
*
C     LSAME = CA(1) .EQ. CB  .AND.  CA(1) .NE. CHAR(ICIRFX)
C
C     IF (LSAME) RETURN
*
*     The characters are not identical.  Now check them for equivalence.
*     Look for the 'escape' character, circumflex, followed by the
*     letter.
*
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     END IF
C
C     RETURN
C
*     End of LSAME.
*
      END
1	aw0a	1	LOGICAL FUNCTION LSAME ( CA, CB )
2			* .. Scalar Arguments ..
3			CHARACTER*1 CA, CB
4			* ..
5			* Purpose
6			* =======
7			*
8			* LSAME tests if CA is the same letter as CB regardless of case.
9			*
10			* N.B. This version of the routine is only correct for ASCII code.
11			* Installers must modify the routine for other character-codes.
12			*
13			* For EBCDIC systems the constant IOFF must be changed to -64.
14			* For CDC system using 6-12 bit representations, the system-
15			* specific code in comments must be activated.
16			*
17			* Parameters
18			* ==========
19			*
20			* CA - CHARACTER*1
21			* CB - CHARACTER*1
22			* On entry, CA and CB specify characters to be compared.
23			* Unchanged on exit.
24			*
25			*
26			* Auxiliary routine for Level 2 Blas.
27			*
28			* -- Written on 11-October-1988.
29			* Richard Hanson, Sandia National Labs.
30			* Jeremy Du Croz, Nag Central Office.
31			*
32			* .. Parameters ..
33			INTEGER IOFF
34			PARAMETER ( IOFF = 32 )
35			* .. Intrinsic Functions ..
36			INTRINSIC ICHAR
37			* .. Executable Statements ..
38			*
39			* Test if the characters are equal
40			*
41			LSAME = CA .EQ. CB
42			*
43			* Now test for equivalence
44			*
45			IF ( .NOT. LSAME ) THEN
46			LSAME = ICHAR( CA) - IOFF .EQ. ICHAR( CB)
47			END IF
48			IF ( .NOT. LSAME ) THEN
49			LSAME = ICHAR( CA) .EQ. ICHAR( CB) - IOFF
50			END IF
51			*
52			RETURN
53			*
54			* The following comments contain code for CDC systems using 6-12 bit
55			* representations.
56			*
57			* .. Parameters ..
58			C INTEGER ICIRFX
59			C PARAMETER ( ICIRFX = 62 )
60			* .. Scalar Arguments ..
61			C CHARACTER*1 CB
62			* .. Array Arguments ..
63			C CHARACTER1 CA()
64			* .. Local Scalars ..
65			C INTEGER IVAL
66			* .. Intrinsic Functions ..
67			C INTRINSIC ICHAR, CHAR
68			* .. Executable Statements ..
69			*
70			* See if the first character in string CA equals string CB.
71			*
72			C LSAME = CA(1) .EQ. CB .AND. CA(1) .NE. CHAR(ICIRFX)
73			C
74			C IF (LSAME) RETURN
75			*
76			* The characters are not identical. Now check them for equivalence.
77			* Look for the 'escape' character, circumflex, followed by the
78			* letter.
79			*
80			C IVAL = ICHAR( CA(2))
81			C IF ( IVAL .GE. ICHAR('A') .AND. IVAL .LE. ICHAR('Z')) THEN
82			C LSAME = CA(1) .EQ. CHAR(ICIRFX) .AND. CA(2) .EQ. CB
83			C END IF
84			C
85			C RETURN
86			C
87			* End of LSAME.
88			*
89			END