Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
zzlabl.c
Go to the documentation of this file.00001
00002
00003
00004
00005
00006 #include "f2c.h"
00007
00008
00009
00010 static integer c__1 = 1;
00011
00012
00013
00014
00015 int zzlabl_(real *val, char *cout, integer *nchar, ftnlen
00016 cout_len)
00017 {
00018
00019 static char fmt_101[] = "(f9.3)";
00020 static char fmt_301[] = "(1pe9.2)";
00021
00022
00023 integer i__1;
00024
00025
00026 int s_copy(char *, char *, ftnlen, ftnlen);
00027 integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
00028 ;
00029
00030
00031 static integer nbot, ntop, n, nch;
00032 static char buf[10];
00033
00034
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
00041
00042
00043
00044
00045
00046 --cout;
00047
00048
00049 if (*val == 0.f) {
00050 s_copy(buf, "0", 10L, 1L);
00051 nch = 1;
00052
00053
00054
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
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
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
00088
00089 nch = ntop - nbot + 1;
00090 s_copy(buf, buf + (nbot - 1), nch, ntop - (nbot - 1));
00091
00092
00093
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
00112 }
00113 *nchar = nch;
00114
00115 return 0;
00116 }
00117