← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/scicos/readau.c

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/scicos/readau.c
 
1
#include <stdio.h>
 
2
#include <stdlib.h>
 
3
#include <math.h> 
 
4
#include "../machine.h"
 
5
 
 
6
 
 
7
void 
 
8
readau(flag,nevprt,t,xd,x,nx,z,nz,tvec,ntvec,rpar,nrpar,
 
9
               ipar,nipar,inptr,insz,nin,outptr,outsz,nout)
 
10
     /*
 
11
     ipar[1]   = lfil : file name length
 
12
     ipar[2:4] = fmt  : numbers type ascii code
 
13
     ipar[5]   = void
 
14
     ipar[6]   = n : buffer length in number of records
 
15
     ipar[7]   = maxvoie : record size
 
16
     ipar[8]   = swap
 
17
     ipar[9]   = first : first record to read
 
18
     ipar[10:9+lfil] = character codes for file name
 
19
     */
 
20
integer *flag,*nevprt,*nx,*nz,*ntvec,*nrpar,ipar[],*nipar;
 
21
integer insz[],*nin,outsz[],*nout;
 
22
double x[],xd[],z[],tvec[],rpar[];
 
23
double *inptr[],*outptr[],*t;
 
24
 
 
25
{
 
26
  char str[100],type[4];
 
27
  int job = 1,three=3;
 
28
  FILE *fd;
 
29
  int n, k, kmax, no, lfil, m, i, irep, nm, ierr;
 
30
  double *buffer,*record;
 
31
  long offset;
 
32
  double y;
 
33
  /*  div_t divt;*/int quot, rem;
 
34
  double SCALE=0.000030517578125;
 
35
  /*  int ETAB[8]={0, 132, 396, 924, 1980, 4092, 8316, 16764}; */
 
36
  int ETAB[8];
 
37
  int mu;
 
38
  int sig;
 
39
  int e;
 
40
  int f;
 
41
  double ff;
 
42
  double two=2.0;
 
43
 
 
44
  ETAB[0]=0; ETAB[1]=132; ETAB[2]= 396; ETAB[3]=924; ETAB[4]=1980;
 
45
  ETAB[5]=4092; ETAB[6]=8316; ETAB[7]=16764;
 
46
 
 
47
  --ipar;
 
48
  --z;
 
49
  fd=(FILE *)(long)z[3];
 
50
  buffer = (z+4);
 
51
    
 
52
  /*
 
53
    k    : record counter within the buffer
 
54
    kmax :  number of records in the buffer
 
55
  */
 
56
 
 
57
  if (*flag==1) {
 
58
    n    = ipar[6];
 
59
    k    = z[1];
 
60
    /* copy current record to output */
 
61
    record=buffer+(k-1)*ipar[7];
 
62
 
 
63
    for (i=0;i<*nout;i++)
 
64
      {
 
65
        mu=(int) record[i];
 
66
 
 
67
        mu=255-mu;
 
68
        if(mu>127)
 
69
          sig=1;
 
70
        else
 
71
          sig=0;
 
72
        /* comment out for SUNOS SS 8/10/99 
 
73
        divt=div(mu,16);
 
74
        e=divt.quot-8*sig+1;
 
75
        f=divt.rem;
 
76
        */
 
77
        quot=mu/16;rem=mu-16*quot;
 
78
        e=quot-8*sig+1;
 
79
        f=rem;
 
80
 
 
81
        y=ldexp((double)(f),(e+2));
 
82
        /* ff=(double)(e+2);
 
83
           y=((double) f) * pow(two, ff); */
 
84
 
 
85
        e=ETAB[e-1];
 
86
 
 
87
        y=SCALE*(1-2*sig)*(e+y);
 
88
 
 
89
        *outptr[i]=y;
 
90
      }
 
91
    if (*nevprt>0) {
 
92
      /*     discrete state */
 
93
      kmax = z[2];
 
94
      if (k>=kmax&&kmax==n) {
 
95
        /*     read a new buffer */
 
96
        m=ipar[6]*ipar[7];
 
97
        F2C(cvstr)(&three,&(ipar[2]),type,&job);
 
98
        for (i=2;i>=0;i--)
 
99
          if (type[i]!=' ') { type[i+1]='\0';break;}
 
100
        ierr=0;
 
101
        mget2(fd,ipar[8],buffer,m,type,&ierr);
 
102
        if (ierr>0) {
 
103
          sciprint("Read error!\n");
 
104
          fclose(fd);
 
105
          z[3] = 0.0;
 
106
          *flag = -1;
 
107
          return;
 
108
        }
 
109
        else if (ierr<0) { /* EOF reached */
 
110
          kmax=-(ierr+1)/ipar[7];
 
111
        }
 
112
        else
 
113
          kmax=ipar[6];
 
114
 
 
115
        z[1] = 1.0;
 
116
        z[2] = kmax;
 
117
      }
 
118
      else if (k<kmax) 
 
119
        z[1] = z[1]+1.0;
 
120
    }
 
121
  }
 
122
  else if (*flag==4) {
 
123
    F2C(cvstr)(&(ipar[1]),&(ipar[10]),str,&job);
 
124
    str[ipar[1]] = '\0';
 
125
    fd = fopen(str,"rb");
 
126
    if (!fd ) {
 
127
      sciprint("Could not open the file!\n");
 
128
      *flag = -1;
 
129
      return;
 
130
    }
 
131
    z[3]=(long)fd;
 
132
    /* skip first records */
 
133
    if (ipar[9]>1) {
 
134
      F2C(cvstr)(&three,&(ipar[2]),type,&job);
 
135
      for (i=2;i>=0;i--)
 
136
          if (type[i]!=' ') { type[i+1]='\0';break;}
 
137
      offset=(ipar[9]-1)*ipar[7]*sizeof(char);
 
138
      irep = fseek(fd,offset,0) ;
 
139
      if ( irep != 0 ) 
 
140
        {
 
141
          sciprint("Read error\r\n");
 
142
          *flag = -1;
 
143
          fclose(fd);
 
144
          z[3] = 0.0;
 
145
          return;
 
146
        }
 
147
    }
 
148
    /* read first buffer */
 
149
    m=ipar[6]*ipar[7];
 
150
    F2C(cvstr)(&three,&(ipar[2]),type,&job);
 
151
    for (i=2;i>=0;i--)
 
152
          if (type[i]!=' ') { type[i+1]='\0';break;}
 
153
    mget2(fd,ipar[8],buffer,m,type,&ierr);
 
154
    if (ierr>0) {
 
155
      sciprint("Read error!\n");
 
156
      *flag = -1;
 
157
      fclose(fd);
 
158
      z[3] = 0.0;
 
159
      return;
 
160
    }
 
161
    else if (ierr<0) { /* EOF reached */
 
162
      kmax=-(ierr+1)/ipar[7];
 
163
    }
 
164
    else
 
165
      kmax=ipar[6];
 
166
 
 
167
    z[1] = 1.0;
 
168
    z[2] = kmax;
 
169
  }
 
170
  else if (*flag==5) {
 
171
    if(z[3]==0) return;
 
172
    fclose(fd);
 
173
    z[3] = 0.0;
 
174
  }
 
175
  return;
 
176
}
 
177