Doxygen Source Code Documentation
lwrite.c File Reference
#include "f2c.h"#include "fio.h"#include "fmt.h"#include "lio.h"Go to the source code of this file.
Defines | |
| #define | Ptr ((flex *)ptr) |
Functions | |
| VOID | donewrec (Void) |
| t_putc (int c) | |
| VOID | lwrt_I (longint n) |
| VOID | lwrt_L (ftnint n, ftnlen len) |
| VOID | lwrt_A (char *p, ftnlen len) |
| int | l_g (char *buf, double n) |
| VOID | l_put (register char *s) |
| VOID | lwrt_F (double n) |
| VOID | lwrt_C (double a, double b) |
| l_write (ftnint *number, char *ptr, ftnlen len, ftnint type) | |
Variables | |
| ftnint | L_len |
| int | f__Aquote |
Define Documentation
|
|
|
Function Documentation
|
|
Definition at line 10 of file lwrite.c. Referenced by lwrt_A(), lwrt_C(), lwrt_F(), lwrt_I(), and lwrt_L().
00011 {
00012 if (f__recpos)
00013 (*f__donewrec)();
00014 }
|
|
||||||||||||
|
Definition at line 105 of file lwrite.c. References c, f__ret, and LGFMT. Referenced by lwrt_C(), and lwrt_F().
00107 {
00108 #ifdef Old_list_output
00109 doublereal absn;
00110 char *fmt;
00111
00112 absn = n;
00113 if (absn < 0)
00114 absn = -absn;
00115 fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT;
00116 #ifdef USE_STRLEN
00117 sprintf(buf, fmt, n);
00118 return strlen(buf);
00119 #else
00120 return sprintf(buf, fmt, n);
00121 #endif
00122
00123 #else
00124 register char *b, c, c1;
00125
00126 b = buf;
00127 *b++ = ' ';
00128 if (n < 0) {
00129 *b++ = '-';
00130 n = -n;
00131 }
00132 else
00133 *b++ = ' ';
00134 if (n == 0) {
00135 *b++ = '0';
00136 *b++ = '.';
00137 *b = 0;
00138 goto f__ret;
00139 }
00140 sprintf(b, LGFMT, n);
00141 switch(*b) {
00142 #ifndef WANT_LEAD_0
00143 case '0':
00144 while(b[0] = b[1])
00145 b++;
00146 break;
00147 #endif
00148 case 'i':
00149 case 'I':
00150 /* Infinity */
00151 case 'n':
00152 case 'N':
00153 /* NaN */
00154 while(*++b);
00155 break;
00156
00157 default:
00158 /* Fortran 77 insists on having a decimal point... */
00159 for(;; b++)
00160 switch(*b) {
00161 case 0:
00162 *b++ = '.';
00163 *b = 0;
00164 goto f__ret;
00165 case '.':
00166 while(*++b);
00167 goto f__ret;
00168 case 'E':
00169 for(c1 = '.', c = 'E'; *b = c1;
00170 c1 = c, c = *++b);
00171 goto f__ret;
00172 }
00173 }
00174 f__ret:
00175 return b - buf;
00176 #endif
00177 }
|
|
|
Definition at line 183 of file lwrite.c. References c. Referenced by lwrt_C(), and lwrt_F().
|
|
||||||||||||||||||||
|
Definition at line 245 of file lwrite.c. References f__fatal(), i, lwrt_A(), lwrt_C(), lwrt_F(), lwrt_I(), lwrt_L(), and TYQUAD. Referenced by x_wsne().
00247 {
00248 #define Ptr ((flex *)ptr)
00249 int i;
00250 longint x;
00251 double y,z;
00252 real *xx;
00253 doublereal *yy;
00254 for(i=0;i< *number; i++)
00255 {
00256 switch((int)type)
00257 {
00258 default: f__fatal(204,"unknown type in lio");
00259 case TYINT1:
00260 x = Ptr->flchar;
00261 goto xint;
00262 case TYSHORT:
00263 x=Ptr->flshort;
00264 goto xint;
00265 #ifdef Allow_TYQUAD
00266 case TYQUAD:
00267 x = Ptr->fllongint;
00268 goto xint;
00269 #endif
00270 case TYLONG:
00271 x=Ptr->flint;
00272 xint: lwrt_I(x);
00273 break;
00274 case TYREAL:
00275 y=Ptr->flreal;
00276 goto xfloat;
00277 case TYDREAL:
00278 y=Ptr->fldouble;
00279 xfloat: lwrt_F(y);
00280 break;
00281 case TYCOMPLEX:
00282 xx= &Ptr->flreal;
00283 y = *xx++;
00284 z = *xx;
00285 goto xcomplex;
00286 case TYDCOMPLEX:
00287 yy = &Ptr->fldouble;
00288 y= *yy++;
00289 z = *yy;
00290 xcomplex:
00291 lwrt_C(y,z);
00292 break;
00293 case TYLOGICAL1:
00294 x = Ptr->flchar;
00295 goto xlog;
00296 case TYLOGICAL2:
00297 x = Ptr->flshort;
00298 goto xlog;
00299 case TYLOGICAL:
00300 x = Ptr->flint;
00301 xlog: lwrt_L(Ptr->flint, len);
00302 break;
00303 case TYCHAR:
00304 lwrt_A(ptr,len);
00305 break;
00306 }
00307 ptr += len;
00308 }
00309 return(0);
00310 }
|
|
||||||||||||
|
Definition at line 60 of file lwrite.c. References a, donewrec(), L_len, p, and PUT. Referenced by l_write().
00062 {
00063 int a;
00064 char *p1, *pe;
00065
00066 a = 0;
00067 pe = p + len;
00068 if (f__Aquote) {
00069 a = 3;
00070 if (len > 1 && p[len-1] == ' ') {
00071 while(--len > 1 && p[len-1] == ' ');
00072 pe = p + len;
00073 }
00074 p1 = p;
00075 while(p1 < pe)
00076 if (*p1++ == '\'')
00077 a++;
00078 }
00079 if(f__recpos+len+a >= L_len)
00080 donewrec();
00081 if (a
00082 #ifndef OMIT_BLANK_CC
00083 || !f__recpos
00084 #endif
00085 )
00086 PUT(' ');
00087 if (a) {
00088 PUT('\'');
00089 while(p < pe) {
00090 if (*p == '\'')
00091 PUT('\'');
00092 PUT(*p++);
00093 }
00094 PUT('\'');
00095 }
00096 else
00097 while(p < pe)
00098 PUT(*p++);
00099 }
|
|
||||||||||||
|
Definition at line 212 of file lwrite.c. References a, donewrec(), l_g(), L_len, l_put(), LEFBL, and PUT. Referenced by l_write().
00214 {
00215 char *ba, *bb, bufa[LEFBL], bufb[LEFBL];
00216 int al, bl;
00217
00218 al = l_g(bufa, a);
00219 for(ba = bufa; *ba == ' '; ba++)
00220 --al;
00221 bl = l_g(bufb, b) + 1; /* intentionally high by 1 */
00222 for(bb = bufb; *bb == ' '; bb++)
00223 --bl;
00224 if(f__recpos + al + bl + 3 >= L_len)
00225 donewrec();
00226 #ifdef OMIT_BLANK_CC
00227 else
00228 #endif
00229 PUT(' ');
00230 PUT('(');
00231 l_put(ba);
00232 PUT(',');
00233 if (f__recpos + bl >= L_len) {
00234 (*f__donewrec)();
00235 #ifndef OMIT_BLANK_CC
00236 PUT(' ');
00237 #endif
00238 }
00239 l_put(bb);
00240 PUT(')');
00241 }
|
|
|
Definition at line 199 of file lwrite.c. References donewrec(), l_g(), L_len, l_put(), and LEFBL. Referenced by l_write().
|
|
|
Definition at line 30 of file lwrite.c. References donewrec(), f__icvt(), L_len, p, and PUT. Referenced by l_write().
|
|
||||||||||||
|
Definition at line 49 of file lwrite.c. References donewrec(), L_len, LLOGW, and wrt_L(). Referenced by l_write().
|
|
|
Definition at line 19 of file lwrite.c. References c. Referenced by e_wsle().
00021 {
00022 f__recpos++;
00023 putc(c,f__cf);
00024 return(0);
00025 }
|
Variable Documentation
|
|
Definition at line 7 of file lwrite.c. Referenced by x_wsne(). |
|
|
Definition at line 6 of file lwrite.c. Referenced by lwrt_A(), lwrt_C(), lwrt_F(), lwrt_I(), and lwrt_L(). |
