/* zzlabl.f -- translated by f2c (version 19961017).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Table of constant values */
static integer c__1 = 1;
/* Subroutine */ int zzlabl_(real *val, char *cout, integer *nchar, ftnlen
cout_len)
{
/* Format strings */
static char fmt_101[] = "(f9.3)";
static char fmt_301[] = "(1pe9.2)";
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
;
/* Local variables */
static integer nbot, ntop, n, nch;
static char buf[10];
/* Fortran I/O blocks */
static icilist io___3 = { 0, buf, 0, fmt_101, 10, 1 };
static icilist io___6 = { 0, buf, 0, fmt_301, 10, 1 };
/* Generate a character string for a label for a linear axis in DRAXES */
/* .......................................................................
*/
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
/* Parameter adjustments */
--cout;
/* Function Body */
if (*val == 0.f) {
s_copy(buf, "0", 10L, 1L);
nch = 1;
/* ...................................................................
.... */
/* Intermediate values get an F format. */
} else if (dabs(*val) >= .01f && dabs(*val) <= 9999.99f) {
s_wsfi(&io___3);
do_fio(&c__1, (char *)&(*val), (ftnlen)sizeof(real));
e_wsfi();
/* Strip off leading blanks */
nbot = 1;
L100:
if (*(unsigned char *)&buf[nbot - 1] != ' ') {
goto L200;
}
++nbot;
if (nbot < 9) {
goto L100;
}
L200:
/* Strip off trailing zeroes */
ntop = 9;
L300:
if (*(unsigned char *)&buf[ntop - 1] != '0') {
goto L400;
}
--ntop;
if (ntop > nbot) {
goto L300;
}
L400:
/* Store desired part of string in first part of BUF */
nch = ntop - nbot + 1;
s_copy(buf, buf + (nbot - 1), nch, ntop - (nbot - 1));
/* ...................................................................
.... */
/* Large or small values get an E format. */
} else {
s_wsfi(&io___6);
do_fio(&c__1, (char *)&(*val), (ftnlen)sizeof(real));
e_wsfi();
if (*(unsigned char *)buf == ' ') {
s_copy(buf, buf + 1, 8L, 8L);
nch = 8;
} else {
nch = 9;
}
}
/* .......................................................................
*/
i__1 = nch;
for (n = 1; n <= i__1; ++n) {
*(unsigned char *)&cout[n] = *(unsigned char *)&buf[n - 1];
/* L900: */
}
*nchar = nch;
return 0;
} /* zzlabl_ */
syntax highlighted by Code2HTML, v. 0.9.1