/[ascend]/trunk/blas/lsame.f
ViewVC logotype

Annotation of /trunk/blas/lsame.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations) (download)
Fri Oct 29 20:54:12 2004 UTC (15 years, 5 months ago) by aw0a
File size: 2345 byte(s)
Setting up web subdirectory in repository
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 CHARACTER*1 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

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22