1 /* samsub.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 SAMSUB (Same substrings) */
samsub_(char * str1,integer * b1,integer * e1,char * str2,integer * b2,integer * e2,ftnlen str1_len,ftnlen str2_len)9 logical samsub_(char *str1, integer *b1, integer *e1, char *str2, integer *b2,
10 integer *e2, ftnlen str1_len, ftnlen str2_len)
11 {
12 /* System generated locals */
13 logical ret_val;
14
15 /* Builtin functions */
16 integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen);
17
18 /* $ Abstract */
19
20 /* Determine whether or not two substrings are the same */
21
22 /* $ Disclaimer */
23
24 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
25 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
26 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
27 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
28 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
29 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
30 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
31 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
32 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
33 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
34
35 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
36 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
37 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
38 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
39 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
40 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
41
42 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
43 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
44 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
45 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
46
47 /* $ Required_Reading */
48
49 /* None. */
50
51 /* $ Keywords */
52
53 /* UTILITY */
54
55 /* $ Declarations */
56 /* $ Brief_I/O */
57
58 /* VARIABLE I/O DESCRIPTION */
59 /* -------- --- ------------------------------------------------- */
60 /* STR1 I A string */
61 /* B1 I Beginning of a substring in STR1 */
62 /* E1 I End of s substring in STR1 */
63 /* STR2 I A second string */
64 /* B2 I The beginning of a substring in STR2 */
65 /* E2 I The end of s substring in STR2 */
66
67 /* The function returns .TRUE. if the substrings are identical */
68
69 /* $ Detailed_Input */
70
71 /* STR1 is a character string */
72
73 /* B1 are integers giving the beginning and ending of a */
74 /* E1 substring in STR1 */
75
76 /* STR2 is a character string */
77
78 /* B2 are integers giving the beginning and ending of a */
79 /* E2 substring in STR2 */
80
81 /* $ Detailed_Output */
82
83 /* The function returns TRUE if the two substrings STR(B1:E1) and */
84 /* STR(B2:E2) have the same length and the same characters. */
85
86 /* If any of the indices B1, E1, B2, E2 are out of range or out */
87 /* of order the function returns FALSE. */
88
89 /* $ Parameters */
90
91 /* None. */
92
93 /* $ Files */
94
95 /* None. */
96
97 /* $ Exceptions */
98
99 /* Error free. */
100
101 /* 1) If any of the B1, E1, B2, E2 are out of range or if an */
102 /* ending substring index is before a beginning substring */
103 /* index, the function returns false. */
104
105 /* $ Particulars */
106
107 /* This routine is a macro for comparing two substrings of */
108 /* strings and handles all of the bounds checking to avoid */
109 /* out of range errors with string indices. */
110
111 /* $ Examples */
112
113 /* Suppose a string contains a number of occurrences of some */
114 /* particular substring in sequence and that you need to locate */
115 /* the first character that is out of this sequence or the */
116 /* end of the string. */
117
118 /* If one ignores boundary constraints this can easily be */
119 /* coded as shown here: We assume the particular substring is */
120
121 /* '/beg' */
122
123 /* B = 1 */
124 /* E = B + LEN('/beg' ) */
125
126 /* DO WHILE ( E .LE. LEN(STR) */
127 /* .AND. STRING(B:E) .EQ. '/beg' ) */
128
129 /* B = B + LEN('/beg') */
130 /* E = E + LEN('/beg') */
131
132 /* END DO */
133
134 /* IF ( B .LT. LEN(STR) ) THEN */
135
136 /* we've found the start of a substring of interest */
137
138 /* ELSE */
139
140 /* there is no substring to find. */
141
142 /* END IF */
143
144 /* Unfortunately, you can't rely upon FORTRAN to check the boundary */
145 /* condition: E .LE. LEN(STR) and skip the second test if the first */
146 /* condition if false. As a result you can get an out of range */
147 /* error. */
148
149 /* Instead you could code: */
150
151 /* B = 1 */
152 /* E = B + LEN('/beg') */
153
154 /* IF ( E .LE. LEN(STR) ) THEN */
155 /* ALIKE = STRINB(B:E) .EQ. '/beg' */
156 /* ELSE */
157 /* ALIKE = .FALSE. */
158 /* END IF */
159
160 /* DO WHILE ( ALIKE ) */
161
162 /* B = B + LEN('/beg') */
163 /* E = E + LEN('/beg') */
164
165 /* IF ( E .LE. LEN(STR) ) THEN */
166 /* ALIKE = STRINB(B:E) .EQ. '/beg' */
167 /* ELSE */
168 /* ALIKE = .FALSE. */
169 /* END IF */
170
171 /* END DO */
172
173
174 /* However, this is code is far more effort. Using this routine */
175 /* you can make a much simpler block of code. */
176
177 /* B = 1 */
178 /* E = B + LEN('/beg' ) */
179
180 /* DO WHILE ( SAMSUB(STR,B,E, '/beg',1,4 ) ) */
181
182 /* B = B + LEN('/beg') */
183 /* E = E + LEN('/beg') */
184
185 /* END DO */
186
187
188
189 /* $ Restrictions */
190
191 /* None. */
192
193 /* $ Author_and_Institution */
194
195 /* W.L. Taber (JPL) */
196
197 /* $ Literature_References */
198
199 /* None. */
200
201 /* $ Version */
202
203 /* - SPICELIB Version 1.0.0, 31-MAR-1995 (WLT) */
204
205
206 /* -& */
207 /* $ Index_Entries */
208
209 /* Check equality of two substrings. */
210
211 /* -& */
212 if (*e1 < *b1 || *e2 < *b2 || *b1 < 1 || *b2 < 1 || *e1 > i_len(str1,
213 str1_len) || *e2 > i_len(str2, str2_len) || *e1 - *b1 != *e2 - *
214 b2) {
215 ret_val = FALSE_;
216 return ret_val;
217 }
218 ret_val = s_cmp(str1 + (*b1 - 1), str2 + (*b2 - 1), *e1 - (*b1 - 1), *e2
219 - (*b2 - 1)) == 0;
220 return ret_val;
221 } /* samsub_ */
222
223