1 /* samchi.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* $Procedure SAMCHI ( Same character --- case insensitive ) */
samchi_(char * str1,integer * l1,char * str2,integer * l2,ftnlen str1_len,ftnlen str2_len)9 logical samchi_(char *str1, integer *l1, char *str2, integer *l2, ftnlen
10 str1_len, ftnlen str2_len)
11 {
12 /* System generated locals */
13 logical ret_val;
14
15 /* Builtin functions */
16 integer i_len(char *, ftnlen);
17
18 /* Local variables */
19 extern logical eqchr_(char *, char *, ftnlen, ftnlen);
20
21 /* $ Abstract */
22
23 /* Determine if two characters from different strings are the */
24 /* same when the case of the characters is ignored. */
25
26 /* $ Disclaimer */
27
28 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
29 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
30 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
31 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
32 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
33 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
34 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
35 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
36 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
37 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
38
39 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
40 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
41 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
42 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
43 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
44 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
45
46 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
47 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
48 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
49 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
50
51 /* $ Required_Reading */
52
53 /* None. */
54
55 /* $ Keywords */
56
57 /* UTILITY */
58
59 /* $ Declarations */
60 /* $ Brief_I/O */
61
62 /* VARIABLE I/O DESCRIPTION */
63 /* -------- --- -------------------------------------------------- */
64 /* STR1 I A character string */
65 /* L1 I The location (index) of a character in STR1 */
66 /* STR2 I A character string */
67 /* L2 I The location (index) of a character in STR2 */
68
69 /* The function returns TRUE if the two characters are the */
70 /* same up to case. */
71
72 /* $ Detailed_Input */
73
74 /* STR1 is a character string */
75
76 /* L1 is the location (index) of a character in STR1 */
77
78 /* STR2 is a character string */
79
80 /* L2 is the location (index) of a character in STR2 */
81
82 /* $ Detailed_Output */
83
84
85 /* The function returns TRUE if the characters STR1(L1:L1) and */
86 /* STR2(L2:L2) are the same when the case of the characters is */
87 /* ignored. */
88
89 /* If the characters are different or L1 or L2 is out of range the */
90 /* function returns FALSE. */
91
92 /* $ Parameters */
93
94 /* None. */
95
96 /* $ Files */
97
98 /* None. */
99
100 /* $ Exceptions */
101
102 /* Error free. */
103
104 /* 1) If either L1 or L2 is out of range the function returns FALSE. */
105
106 /* $ Particulars */
107
108 /* This is a utility function for determining whether or not */
109 /* two characters in different strings are the same up to case. */
110 /* This function is intended for situation in which you need */
111 /* to search two strings for a match (or mismatch). */
112
113 /* $ Examples */
114
115 /* Often you need to scan through two string comparing */
116 /* character by character until a case insensitive mismatch */
117 /* occurs. The usual way to code this is */
118
119 /* DO WHILE ( L1 .LE. LEN(STR1) */
120 /* .AND. L2 .LE. LEN(STR2) */
121 /* .AND. EQCHR( STR1(L1:L1),STR2(L2:L2) ) ) */
122
123 /* L1 = L1 + 1 */
124 /* L2 = L2 + 1 */
125
126 /* END DO */
127
128 /* Check L1, L2 to make sure we are still in range, etc. */
129
130 /* The problem with this loop is that even though the check to make */
131 /* sure that L1 and L2 are in range is performed, FORTRAN may */
132 /* go ahead and compute the equality condition even though one of the */
133 /* first two steps failed. This can lead to out of range errors */
134 /* and possible halting of your program depending upon how */
135 /* the routine is compiled. An alternative way to code this is */
136
137 /* IF ( L1 .LE. LEN(STR1) .AND. L2 .LE. LEN(STR2) ) THEN */
138 /* ALIKE = EQCHR( STR1(L1:L1),STR2(L2:L2) ) */
139 /* ELSE */
140 /* ALIKE = .FALSE. */
141 /* END IF */
142
143 /* DO WHILE ( ALIKE ) */
144
145 /* L1 = L1 + 1 */
146 /* L2 = L2 + 1 */
147
148 /* IF ( L1 .LE. LEN(STR1) .AND. L2 .LE. LEN(STR2) ) THEN */
149 /* ALIKE = EQCHR( STR1(L1:L1), STR2(L2:L2) ) */
150 /* ELSE */
151 /* ALIKE = .FALSE. */
152 /* END IF */
153 /* END DO */
154
155 /* However this is a much more complicated section of code. This */
156 /* routine allows you to code the above loops as: */
157
158
159 /* DO WHILE ( SAMCHI ( STR1,L1, STR2,L2 ) ) */
160 /* L1 = L1 + 1 */
161 /* L2 = L2 + 1 */
162 /* END DO */
163
164 /* The boundary checks are automatically performed and out */
165 /* of range errors are avoided. */
166
167
168
169 /* $ Restrictions */
170
171 /* None. */
172
173 /* $ Author_and_Institution */
174
175 /* W.L. Taber (JPL) */
176
177 /* $ Literature_References */
178
179 /* None. */
180
181 /* $ Version */
182
183 /* - SPICELIB Version 1.0.0, 31-MAR-1995 (WLT) */
184
185
186 /* -& */
187 /* $ Index_Entries */
188
189 /* Check two character substrings for case insensitive equal */
190
191 /* -& */
192
193 /* Spicelib Functions */
194
195 if (*l1 < 1 || *l2 < 1 || *l1 > i_len(str1, str1_len) || *l2 > i_len(str2,
196 str2_len)) {
197 ret_val = FALSE_;
198 return ret_val;
199 }
200 ret_val = eqchr_(str1 + (*l1 - 1), str2 + (*l2 - 1), (ftnlen)1, (ftnlen)1)
201 ;
202 return ret_val;
203 } /* samchi_ */
204
205