/* 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