00001 /* zzlabl.f -- translated by f2c (version 19961017).
00002    You must link the resulting object file with the libraries:
00003         -lf2c -lm   (in that order)
00004 */
00005 
00006 #include "f2c.h"
00007 
00008 /* Table of constant values */
00009 
00010 static integer c__1 = 1;
00011 
00012 
00013 
00014 
00015 /* Subroutine */ int zzlabl_(real *val, char *cout, integer *nchar, ftnlen 
00016         cout_len)
00017 {
00018     /* Format strings */
00019     static char fmt_101[] = "(f9.3)";
00020     static char fmt_301[] = "(1pe9.2)";
00021 
00022     /* System generated locals */
00023     integer i__1;
00024 
00025     /* Builtin functions */
00026     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00027     integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
00028             ;
00029 
00030     /* Local variables */
00031     static integer nbot, ntop, n, nch;
00032     static char buf[10];
00033 
00034     /* Fortran I/O blocks */
00035     static icilist io___3 = { 0, buf, 0, fmt_101, 10, 1 };
00036     static icilist io___6 = { 0, buf, 0, fmt_301, 10, 1 };
00037 
00038 
00039 
00040 /*  Generate a character string for a label for a linear axis in DRAXES */
00041 /* .......................................................................
00042  */
00043 /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00044  */
00045     /* Parameter adjustments */
00046     --cout;
00047 
00048     /* Function Body */
00049     if (*val == 0.f) {
00050         s_copy(buf, "0", 10L, 1L);
00051         nch = 1;
00052 /* ...................................................................
00053 .... */
00054 /*   Intermediate values get an F format. */
00055 
00056     } else if (dabs(*val) >= .01f && dabs(*val) <= 9999.99f) {
00057         s_wsfi(&io___3);
00058         do_fio(&c__1, (char *)&(*val), (ftnlen)sizeof(real));
00059         e_wsfi();
00060 
00061 /*  Strip off leading blanks */
00062 
00063         nbot = 1;
00064 L100:
00065         if (*(unsigned char *)&buf[nbot - 1] != ' ') {
00066             goto L200;
00067         }
00068         ++nbot;
00069         if (nbot < 9) {
00070             goto L100;
00071         }
00072 L200:
00073 
00074 /*  Strip off trailing zeroes */
00075 
00076         ntop = 9;
00077 L300:
00078         if (*(unsigned char *)&buf[ntop - 1] != '0') {
00079             goto L400;
00080         }
00081         --ntop;
00082         if (ntop > nbot) {
00083             goto L300;
00084         }
00085 L400:
00086 
00087 /*  Store desired part of string in first part of BUF */
00088 
00089         nch = ntop - nbot + 1;
00090         s_copy(buf, buf + (nbot - 1), nch, ntop - (nbot - 1));
00091 /* ...................................................................
00092 .... */
00093 /*  Large or small values get an E format. */
00094 
00095     } else {
00096         s_wsfi(&io___6);
00097         do_fio(&c__1, (char *)&(*val), (ftnlen)sizeof(real));
00098         e_wsfi();
00099         if (*(unsigned char *)buf == ' ') {
00100             s_copy(buf, buf + 1, 8L, 8L);
00101             nch = 8;
00102         } else {
00103             nch = 9;
00104         }
00105     }
00106 /* .......................................................................
00107  */
00108     i__1 = nch;
00109     for (n = 1; n <= i__1; ++n) {
00110         *(unsigned char *)&cout[n] = *(unsigned char *)&buf[n - 1];
00111 /* L900: */
00112     }
00113     *nchar = nch;
00114 
00115     return 0;
00116 } /* zzlabl_ */
00117