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

Contents of /trunk/blas/lsame.f

Parent Directory Parent Directory | Revision Log Revision Log


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