1: #include "fio.h"
2: #include "lio.h"
3: extern int l_write();
4: int t_putc();
5: s_wsle(a) cilist *a;
6: {
7: int n;
8: if(!init) f_init();
9: if(n=c_le(a,WRITE)) return(n);
10: reading=0;
11: external=1;
12: formatted=1;
13: putn = t_putc;
14: lioproc = l_write;
15: if(!curunit->uwrt)
16: return(nowwriting(curunit));
17: else return(0);
18: }
19: e_wsle()
20: {
21: t_putc('\n');
22: recpos=0;
23: return(0);
24: }
25: t_putc(c)
26: {
27: recpos++;
28: putc(c,cf);
29: }
30: lwrt_I(n) ftnint n;
31: {
32: char buf[LINTW],*p;
33: sprintf(buf," %ld",(long)n);
34: if(recpos+strlen(buf)>=LINE)
35: { t_putc('\n');
36: recpos=0;
37: }
38: for(p=buf;*p;t_putc(*p++));
39: }
40: lwrt_L(n) ftnint n;
41: {
42: if(recpos+LLOGW>=LINE)
43: { t_putc('\n');
44: recpos=0;
45: }
46: wrt_L(&n,LLOGW);
47: }
48: lwrt_A(p,len) char *p; ftnlen len;
49: {
50: int i;
51: if(recpos+len>=LINE)
52: {
53: t_putc('\n');
54: recpos=0;
55: }
56: t_putc(' ');
57: for(i=0;i<len;i++) t_putc(*p++);
58: }
59: lwrt_F(n) double n;
60: {
61: if(LLOW<=n && n<LHIGH)
62: {
63: if(recpos+LFW>=LINE)
64: {
65: t_putc('\n');
66: recpos=0;
67: }
68: scale=0;
69: wrt_F(&n,LFW,LFD,(ftnlen)sizeof(n));
70: }
71: else
72: {
73: if(recpos+LEW>=LINE)
74: { t_putc('\n');
75: recpos=0;
76: }
77: wrt_E(&n,LEW,LED,LEE,(ftnlen)sizeof(n));
78: }
79: }
80: lwrt_C(a,b) double a,b;
81: {
82: if(recpos+2*LFW+3>=LINE)
83: { t_putc('\n');
84: recpos=0;
85: }
86: t_putc(' ');
87: t_putc('(');
88: lwrt_F(a);
89: lwrt_F(b);
90: t_putc(')');
91: }
92: l_write(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len;
93: {
94: int i;
95: ftnint x;
96: double y,z;
97: float *xx;
98: double *yy;
99: for(i=0;i< *number; i++)
100: {
101: switch((int)type)
102: {
103: default: fatal(204,"unknown type in lio");
104: case TYSHORT: x=ptr->flshort;
105: goto xint;
106: case TYLONG: x=ptr->flint;
107: xint: lwrt_I(x);
108: break;
109: case TYREAL: y=ptr->flreal;
110: goto xfloat;
111: case TYDREAL: y=ptr->fldouble;
112: xfloat: lwrt_F(y);
113: break;
114: case TYCOMPLEX: xx= &(ptr->flreal);
115: y = *xx++;
116: z = *xx;
117: goto xcomplex;
118: case TYDCOMPLEX: yy = &(ptr->fldouble);
119: y= *yy++;
120: z = *yy;
121: xcomplex: lwrt_C(y,z);
122: break;
123: case TYLOGICAL: lwrt_L(ptr->flint);
124: break;
125: case TYCHAR: lwrt_A((char *)ptr,len);
126: break;
127: }
128: ptr = (char *)ptr + len;
129: }
130: return(0);
131: }
Defined functions
s_wsle
defined in line
5;
never used
t_putc
defined in line
25; used 15 times