1 /* ssizec.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 /* Table of constant values */
9
10 static integer c__0 = 0;
11
12 /* $Procedure SSIZEC ( Set the size of a character cell ) */
ssizec_(integer * size,char * cell,ftnlen cell_len)13 /* Subroutine */ int ssizec_(integer *size, char *cell, ftnlen cell_len)
14 {
15 integer i__;
16 extern /* Subroutine */ int chkin_(char *, ftnlen), enchar_(integer *,
17 char *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen),
18 setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen);
19 extern logical return_(void);
20
21 /* $ Abstract */
22
23 /* Set the size (maximum cardinality) of a character cell. */
24
25 /* $ Disclaimer */
26
27 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
28 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
29 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
30 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
31 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
32 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
33 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
34 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
35 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
36 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
37
38 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
39 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
40 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
41 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
42 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
43 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
44
45 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
46 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
47 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
48 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
49
50 /* $ Required_Reading */
51
52 /* CELLS */
53
54 /* $ Keywords */
55
56 /* CELLS */
57
58 /* $ Declarations */
59 /* $ Brief_I/O */
60
61 /* VARIABLE I/O DESCRIPTION */
62 /* -------- --- -------------------------------------------------- */
63 /* SIZE I Size (maximum cardinality) of the cell. */
64 /* CELL O The cell. */
65
66 /* $ Detailed_Input */
67
68 /* SIZE is the size (maximum number of elements) of the cell. */
69
70 /* $ Detailed_Output */
71
72
73 /* CELL is a cell. */
74
75
76 /* On output, the size of the cell is SIZE. The */
77 /* cardinality of the cell is 0. The rest of the */
78 /* control area is zeroed out. */
79
80 /* $ Parameters */
81
82 /* None. */
83
84 /* $ Particulars */
85
86 /* The set cardinality (SCARDC, SCARDD, and SCARDI) and set size */
87 /* (SSIZEC, SSIZED, and SSIZEI) routines are typically used to */
88 /* initialize cells for subsequent use. Since all cell routines */
89 /* expect to find the size and cardinality of a cell in place, */
90 /* no cell can be used until both have been set. */
91
92 /* $ Examples */
93
94 /* In the example below, the size and cardinality of the character */
95 /* cell FRED are set in the main module of the program FLNSTN. */
96 /* Both are subsequently retrieved, and the cardinality changed, */
97 /* in one of its subroutines, WILMA. */
98
99 /* PROGRAM FLNSTN */
100
101 /* CHARACTER*30 FRED ( LBCELL:100 ) */
102 /* . */
103 /* . */
104 /* CALL SSIZEC ( 100, FRED ) */
105 /* . */
106 /* . */
107 /* CALL WILMA ( FRED ) */
108 /* . */
109 /* . */
110 /* STOP */
111 /* END */
112
113
114 /* SUBROUTINE WILMA ( FRED ) */
115
116 /* CHARACTER*(*) FRED ( LBCELL:* ) */
117 /* INTEGER SIZE */
118 /* INTEGER CARD */
119
120 /* INTEGER CARDC */
121 /* INTEGER SIZEC */
122 /* . */
123 /* . */
124 /* SIZE = SIZEC ( FRED ) */
125 /* CARD = CARDC ( FRED ) */
126 /* . */
127 /* . */
128 /* CALL SCARDC ( MIN ( SIZE, CARD ), FRED ) */
129 /* CALL EXCESS ( CARD-SIZE, 'cell' ) */
130 /* . */
131 /* . */
132 /* RETURN */
133 /* END */
134
135
136 /* $ Restrictions */
137
138 /* None. */
139
140 /* $ Exceptions */
141
142 /* None. */
143
144 /* $ Files */
145
146 /* None. */
147
148 /* $ Literature_References */
149
150 /* None. */
151
152 /* $ Author_and_Institution */
153
154 /* N.J. Bachman (JPL) */
155 /* C.A. Curzon (JPL) */
156 /* W.L. Taber (JPL) */
157 /* I.M. Underwood (JPL) */
158
159 /* $ Version */
160
161 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
162
163 /* Comment section for permuted index source lines was added */
164 /* following the header. */
165
166 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (WLT) (IMU) */
167
168 /* -& */
169 /* $ Index_Entries */
170
171 /* set the size of a character cell */
172
173 /* -& */
174 /* $ Revisions */
175
176 /* - Beta Version 2.0.0, 13-MAR-1989 (NJB) */
177
178 /* Check for invalid size value added. An error */
179 /* is signalled if the value is out of range. The cardinality */
180 /* is now automatically reset to 0. The rest of the control */
181 /* area is now zeroed out. */
182
183 /* The examples have been updated to illustrate set initialization */
184 /* without the use of the EMPTYx routines, which have been */
185 /* removed from the library. Errors in the examples have been */
186 /* removed, also. */
187
188 /* -& */
189
190 /* SPICELIB functions */
191
192
193 /* Local variables */
194
195 if (return_()) {
196 return 0;
197 } else {
198 chkin_("SSIZEC", (ftnlen)6);
199 }
200
201 /* The size must be non-negative. Other values will be snubbed. */
202
203 if (*size < 0) {
204 setmsg_("Attempt to set size of cell to invalid value. The value wa"
205 "s #.", (ftnlen)63);
206 errint_("#", size, (ftnlen)1);
207 sigerr_("SPICE(INVALIDSIZE)", (ftnlen)18);
208 chkout_("SSIZEC", (ftnlen)6);
209 return 0;
210 }
211
212 /* Not much to this. */
213
214 enchar_(size, cell + (cell_len << 2), cell_len);
215 enchar_(&c__0, cell + cell_len * 5, cell_len);
216 for (i__ = -5; i__ <= -2; ++i__) {
217 enchar_(&c__0, cell + (i__ + 5) * cell_len, cell_len);
218 }
219 chkout_("SSIZEC", (ftnlen)6);
220 return 0;
221 } /* ssizec_ */
222
223