libflame  revision_anchor
Functions
fla_lsame.c File Reference

(r)

Functions

logical fla_lsame (char *ca, char *cb, ftnlen ca_len, ftnlen cb_len)
 

Function Documentation

◆ fla_lsame()

logical fla_lsame ( char *  ca,
char *  cb,
ftnlen  ca_len,
ftnlen  cb_len 
)

Referenced by fla_dlamch(), and fla_slamch().

21 {
22  /* System generated locals */
23  logical ret_val;
24 
25  /* Local variables */
26  static integer inta, intb, zcode;
27 
28 
29 /* -- LAPACK auxiliary routine (version 3.2) -- */
30 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
31 /* November 2006 */
32 
33 /* .. Scalar Arguments .. */
34 /* .. */
35 
36 /* Purpose */
37 /* ======= */
38 
39 /* LSAME returns .TRUE. if CA is the same letter as CB regardless of */
40 /* case. */
41 
42 /* Arguments */
43 /* ========= */
44 
45 /* CA (input) CHARACTER*1 */
46 /* CB (input) CHARACTER*1 */
47 /* CA and CB specify the single characters to be compared. */
48 
49 /* ===================================================================== */
50 
51 /* .. Intrinsic Functions .. */
52 /* .. */
53 /* .. Local Scalars .. */
54 /* .. */
55 /* .. Executable Statements .. */
56 
57 /* Test if the characters are equal */
58 
59  ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
60  if (ret_val) {
61  return ret_val;
62  }
63 
64 /* Now test for equivalence if both characters are alphabetic. */
65 
66  zcode = 'Z';
67 
68 /* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */
69 /* machines, on which ICHAR returns a value with bit 8 set. */
70 /* ICHAR('A') on Prime machines returns 193 which is the same as */
71 /* ICHAR('A') on an EBCDIC machine. */
72 
73  inta = *(unsigned char *)ca;
74  intb = *(unsigned char *)cb;
75 
76  if (zcode == 90 || zcode == 122) {
77 
78 /* ASCII is assumed - ZCODE is the ASCII code of either lower or */
79 /* upper case 'Z'. */
80 
81  if (inta >= 97 && inta <= 122) {
82  inta += -32;
83  }
84  if (intb >= 97 && intb <= 122) {
85  intb += -32;
86  }
87 
88  } else if (zcode == 233 || zcode == 169) {
89 
90 /* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
91 /* upper case 'Z'. */
92 
93  if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (inta
94  >= 162 && inta <= 169)) {
95  inta += 64;
96  }
97  if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (intb
98  >= 162 && intb <= 169)) {
99  intb += 64;
100  }
101 
102  } else if (zcode == 218 || zcode == 250) {
103 
104 /* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
105 /* plus 128 of either lower or upper case 'Z'. */
106 
107  if (inta >= 225 && inta <= 250) {
108  inta += -32;
109  }
110  if (intb >= 225 && intb <= 250) {
111  intb += -32;
112  }
113  }
114  ret_val = inta == intb;
115 
116 /* RETURN */
117 
118 /* End of LSAME */
119 
120  return ret_val;
121 } /* fla_lsame */
int logical
Definition: FLA_f2c.h:36
int integer
Definition: FLA_f2c.h:25