00001 #include <stdio.h>
00002 #include <string.h>
00003
00004 #include "machine.h"
00005 #include "sciprint.h"
00006
00007 extern int C2F(cvstr) __PARAMS((integer *,integer *,char *,integer *,unsigned long int));
00008
00009 extern void mget2 __PARAMS((FILE *fa, integer swap, double *res, integer n, char *type, integer *ierr));
00010
00011
00012 int worldsize(type)
00013 char type[4];
00014 {
00015 char c;
00016 int wsz;
00017
00018 c=type[0];
00019 if (c=='u') c=type[1];
00020 switch ( c )
00021 {
00022 case 'l' : wsz=sizeof(long);
00023 break;
00024 case 's' : wsz=sizeof(short);
00025 break;
00026 case 'c' : wsz=sizeof(char);
00027 break;
00028 case 'd' : wsz=sizeof(double);
00029 break;
00030 case 'f' : wsz=sizeof(float);
00031 break;
00032 }
00033 return wsz;
00034 }
00035 void
00036 readc(flag,nevprt,t,xd,x,nx,z,nz,tvec,ntvec,rpar,nrpar,
00037 ipar,nipar,inptr,insz,nin,outptr,outsz,nout)
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049 integer *flag,*nevprt,*nx,*nz,*ntvec,*nrpar,ipar[],*nipar;
00050 integer insz[],*nin,outsz[],*nout;
00051 double x[],xd[],z[],tvec[],rpar[];
00052 double *inptr[],*outptr[],*t;
00053
00054 {
00055 char str[100],type[4];
00056 int job = 1,three=3;
00057 FILE *fd;
00058 int n, k, ievt, kmax, m, i, irep, ierr;
00059 double *buffer,*record;
00060 int *mask;
00061 long offset;
00062
00063
00064 --ipar;
00065 --z;
00066 fd=(FILE *)(long)z[3];
00067 buffer = (z+4);
00068 mask = ipar+11+ipar[1]-ipar[5];
00069
00070
00071
00072
00073
00074
00075 if (*flag==1) {
00076 n = ipar[6];
00077 ievt = ipar[5];
00078 k = (int)z[1];
00079
00080 record=buffer+(k-1)*ipar[7]-1;
00081
00082 for (i=0;i<outsz[0];i++)
00083 *(outptr[0]+i)=record[mask[ievt+i]];
00084
00085 if (*nevprt>0) {
00086
00087 kmax = (int)z[2];
00088 if (k>=kmax&&kmax==n) {
00089
00090 m=ipar[6]*ipar[7];
00091 F2C(cvstr)(&three,&(ipar[2]),type,&job, (unsigned long)strlen(type));
00092 for (i=2;i>=0;i--)
00093 if (type[i]!=' ') { type[i+1]='\0';break;}
00094 ierr=0;
00095 mget2(fd,ipar[8],buffer,m,type,&ierr);
00096 if (ierr>0) {
00097 sciprint("Read error!\n");
00098 fclose(fd);
00099 z[3] = 0.0;
00100 *flag = -1;
00101 return;
00102 }
00103 else if (ierr<0) {
00104 kmax=-(ierr+1)/ipar[7];
00105 }
00106 else
00107 kmax=ipar[6];
00108
00109 z[1] = 1.0;
00110 z[2] = kmax;
00111 }
00112 else if (k<kmax)
00113 z[1] = z[1]+1.0;
00114 }
00115 }
00116 else if (*flag==3) {
00117 ievt = ipar[5];
00118 n = ipar[6];
00119 k = (int)z[1];
00120 kmax = (int) z[2];
00121 if (k > kmax && kmax < n) {
00122 if(ievt)
00123 tvec[0] = *t-1.0;
00124 else
00125 tvec[0] = *t*(1.0+0.0000000001);
00126 }
00127 else {
00128 record=buffer+(k-1)*ipar[7]-1;
00129 if(ievt) tvec[0] = record[mask[0]];
00130 }
00131 }
00132 else if (*flag==4) {
00133 F2C(cvstr)(&(ipar[1]),&(ipar[10]),str,&job,(unsigned long)strlen(str));
00134 str[ipar[1]] = '\0';
00135 fd = fopen(str,"rb");
00136 if (!fd ) {
00137 sciprint("Could not open the file!\n");
00138 *flag = -1;
00139 return;
00140 }
00141 z[3]=(long)fd;
00142
00143 if (ipar[9]>1) {
00144 F2C(cvstr)(&three,&(ipar[2]),type,&job,(unsigned long)strlen(type));
00145 for (i=2;i>=0;i--)
00146 if (type[i]!=' ') { type[i+1]='\0';break;}
00147 offset=(ipar[9]-1)*ipar[7]*worldsize(type);
00148 irep = fseek(fd,offset,0) ;
00149 if ( irep != 0 )
00150 {
00151 sciprint("Read error\r\n");
00152 *flag = -1;
00153 fclose(fd);
00154 z[3] = 0.0;
00155 return;
00156 }
00157 }
00158
00159 m=ipar[6]*ipar[7];
00160 F2C(cvstr)(&three,&(ipar[2]),type,&job,(unsigned long)strlen(type));
00161 for (i=2;i>=0;i--)
00162 if (type[i]!=' ') { type[i+1]='\0';break;}
00163 mget2(fd,ipar[8],buffer,m,type,&ierr);
00164 if (ierr>0) {
00165 sciprint("Read error!\n");
00166 *flag = -1;
00167 fclose(fd);
00168 z[3] = 0.0;
00169 return;
00170 }
00171 else if (ierr<0) {
00172 kmax=-(ierr+1)/ipar[7];
00173 }
00174 else
00175 kmax=ipar[6];
00176
00177 z[1] = 1.0;
00178 z[2] = kmax;
00179 }
00180 else if (*flag==5) {
00181 if(z[3]==0) return;
00182 fclose(fd);
00183 z[3] = 0.0;
00184 }
00185 return;
00186 }
00187