struct blk * sqrt(struct blk *p) { struct blk *t; struct blk *r,*q,*s; int c,n,nn; n = length(p); fsfile(p); c = sbackc(p); if((n&1) != 1)c = c*100+(sfbeg(p)?0:sbackc(p)); n = (n+1)>>1; r = salloc(n); zero(r); seekc(r,n); nn=1; while((c -= nn)>=0)nn+=2; c=(nn+1)>>1; fsfile(r); sbackc(r); if(c>=100){ c -= 100; salterc(r,c); sputc(r,1); } else salterc(r,c); while(1){ q = dcdiv(p,r); s = add(q,r); release(q); release(rem); q = dcdiv(s,sqtemp); release(s); release(rem); s = copy(r,length(r)); chsign(s); t = add(s,q); release(s); fsfile(t); nn = sfbeg(t)?0:sbackc(t); if(nn>=0)break; release(r); release(t); r = q; } release(t); release(q); release(p); return(r); }
struct blk * getdec(struct blk *p,int sc) { int cc; register struct blk *q,*t,*s; rewind(p); if(length(p)*2 < sc){ q = copy(p,length(p)); return(q); } q = salloc(length(p)); while(sc >= 1){ sputc(q,sgetc(p)); sc -= 2; } if(sc != 0){ t = mult(q,tenptr); s = salloc(cc = length(q)); release(q); rewind(t); while(cc-- > 0)sputc(s,sgetc(t)); sputc(s,0); release(t); t = dcdiv(s,tenptr); release(s); release(rem); return(t); } return(q); }
struct blk * removr(struct blk *p,int n) { int nn; register struct blk *q,*s,*r; rewind(p); nn = (n+1)/2; q = salloc(nn); while(n>1){ sputc(q,sgetc(p)); n -= 2; } r = salloc(2); while(sfeof(p) == 0)sputc(r,sgetc(p)); release(p); if(n == 1){ s = dcdiv(r,tenptr); release(r); rewind(rem); if(sfeof(rem) == 0)sputc(q,sgetc(rem)); release(rem); irem = q; return(s); } irem = q; return(r); }
struct blk * exp(struct blk *base,struct blk *ex) { register struct blk *r,*e,*p; struct blk *e1,*t,*cp; int temp,c,n; r = salloc(1); sputc(r,1); p = copy(base,length(base)); e = copy(ex,length(ex)); fsfile(e); if(sfbeg(e) != 0)goto edone; temp=0; c = sbackc(e); if(c<0){ temp++; chsign(e); } while(length(e) != 0){ e1=dcdiv(e,sqtemp); release(e); e = e1; n = length(rem); release(rem); if(n != 0){ e1=mult(p,r); release(r); r = e1; } t = copy(p,length(p)); cp = mult(p,t); release(p); release(t); p = cp; } if(temp != 0){ if((c = length(base)) == 0){ goto edone; } if(c>1)create(r); else{ rewind(base); if((c = sgetc(base))<=1){ create(r); sputc(r,c); } else create(r); } } edone: release(p); release(e); return(r); }
void bigot(struct blk *p,int flg,int putspc) { register struct blk *t,*q; register int l = 0; int neg; if(flg == 1)t = salloc(0); else{ t = strptr; l = length(strptr)+fw-1; } neg=0; if(length(p) != 0){ fsfile(p); if(sbackc(p)<0){ neg=1; chsign(p); } while(length(p) != 0){ q = dcdiv(p,tenptr); release(p); p = q; rewind(rem); sputc(t,sfeof(rem)?'0':sgetc(rem)+'0'); release(rem); } } release(p); if(flg == 1){ l = fw1-length(t); if(neg != 0){ l--; sputc(strptr,'-'); } fsfile(t); while(l-- > 0)sputc(strptr,'0'); while(sfbeg(t) == 0)sputc(strptr,sbackc(t)); release(t); } else{ l -= length(strptr); while(l-- > 0)sputc(strptr,'0'); if(neg != 0){ sunputc(strptr); sputc(strptr,'-'); } } if (putspc) sputc(strptr,' '); return; }
/************************************************************ * APPROX3(T) = ( 16.4955 + T * (20.20933 + T * (11.96482 + * T * (3.778987 + 0.5642236*T)))) * / ( 16.4955 + T * (38.82363 + T * * ( 39.27121 + T * (21.69274 + T * (6.699398 + T))))) ************************************************************/ dcomplex cerf3(dcomplex t) { dcomplex p, q, c; double a[5] = {16.4955, 20.20933, 11.96482, 3.778987, 0.5642236}; double b[6] = {16.4955, 38.82363, 39.27121, 21.69274, 6.699398, 1.0}; p = dcpoly(t, a, 4); q = dcpoly(t, b, 5); c = dcdiv(p, q); return c; }
/************************************************************ * APPROX1(T) = (T * .5641896) / (.5 + (T * T)) ************************************************************/ dcomplex cerf1(dcomplex t) { dcomplex p, q, c; p = dcmultr(t, 0.5641896); q = dcmult(t,t); q = dcaddr(q, 0.5); c = dcdiv(p,q); return c; }
/************************************************************ * APPROX2(T,U) = (T * (1.410474 + U *. 5641896)) / (.75 + (U * (3. + U))) ************************************************************/ dcomplex cerf2(dcomplex t, dcomplex u) { dcomplex p, q, c; p = dcmultr(u, 0.5641896); p = dcaddr(p, 1.410474); p = dcmult(t, p); q = dcaddr(u, 3.0); q = dcmult(u, q); q = dcaddr(q, 0.75); c = dcdiv(p, q); return c; }
struct blk * scale(struct blk *p,int n) { register struct blk *q,*s,*t; t = add0(p,n); q = salloc(1); sputc(q,n); s = dcexp(inbas,q); release(q); q = dcdiv(t,s); release(t); release(s); release(rem); sputc(q,n); return(q); }
/************************************************************ * APPROX4(T,U) = (T * (36183.31 - U * (3321.99 - U * (1540.787 - U * * (219.031 - U *(35.7668 - U *(1.320522 - U * .56419)))))) * / (32066.6 - U * (24322.8 - U * (9022.23 - U * (2186.18 * - U * (364.219 - U * (61.5704 - U * (1.84144 - U)))))))) ************************************************************/ dcomplex cerf4(dcomplex t, dcomplex u) { dcomplex p, q, c; double a[7] = {36183.31, 3321.99, 1540.787, 219.031, 35.7668, 1.320522, 0.56419}; double b[8] = {32066.6, 24322.8, 9022.23, 2186.18, 364.219, 61.5704, 1.84144, 1.0}; /* Polynomials are all in -U */ u = dcmultr(u, -1.0); p = dcpoly(u, a, 6); p = dcmult(t, p); q = dcpoly(u, b, 7); c = dcdiv(p, q); return c; }
struct blk * removc(struct blk *p,int n) { register struct blk *q,*r; rewind(p); while(n>1){ sgetc(p); n -= 2; } q = salloc(2); while(sfeof(p) == 0)sputc(q,sgetc(p)); if(n == 1){ r = dcdiv(q,tenptr); release(q); release(rem); q = r; } release(p); return(q); }
void binop(char c) { register struct blk *r = NULL; switch(c){ case '+': r = add(arg1,arg2); break; case '*': r = mult(arg1,arg2); break; case '/': r = dcdiv(arg1,arg2); break; } release(arg1); release(arg2); sputc(r,savk); pushp(r); return; }
void print(struct blk *hptr) { int sc; register struct blk *p,*q,*dec; int dig,dout,ct; rewind(hptr); while(sfeof(hptr) == 0){ if(sgetc(hptr)>99){ rewind(hptr); while(sfeof(hptr) == 0){ printf("%c",sgetc(hptr)); } printf("\n"); return; } } fsfile(hptr); sc = sbackc(hptr); if(sfbeg(hptr) != 0){ printf("0\n"); return; } count = ll; p = copy(hptr,length(hptr)); sunputc(p); fsfile(p); if(sbackc(p)<0){ chsign(p); OUTC('-'); } if((obase == 0) || (obase == -1)){ oneot(p,sc,'d'); return; } if(obase == 1){ oneot(p,sc,'1'); return; } if(obase == 10){ tenot(p,sc); return; } create(strptr); dig = log_10*sc; dout = ((dig/10) + dig) /logo; dec = getdec(p,sc); p = removc(p,sc); while(length(p) != 0){ q = dcdiv(p,basptr); release(p); p = q; (*outdit)(rem,0,1); } release(p); fsfile(strptr); while(sfbeg(strptr) == 0)OUTC(sbackc(strptr)); if(sc == 0){ release(dec); printf("\n"); return; } create(strptr); OUTC('.'); ct=0; do{ q = mult(basptr,dec); release(dec); dec = getdec(q,sc); p = removc(q,sc); (*outdit)(p,1,ct+1<dout); }while(++ct < dout); release(dec); rewind(strptr); while(sfeof(strptr) == 0)OUTC(sgetc(strptr)); printf("\n"); return; }