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	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