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;
}
