Code covered by the BSD License  

Highlights from
slatec

from slatec by Ben Barrowes
The slatec library converted into matlab functions.

[lun,kprint,ipass]=ddqck(lun,kprint,ipass);
function [lun,kprint,ipass]=ddqck(lun,kprint,ipass);
persistent alfa eps ewt firstCall hmax ierflg ierror impl iwork leniw leniwx lenw lenwmx lenwx liwmx mint miter ml mstate mu mxord mxstep n nde nfe nje nroot nstate nstep ntask nx t tout work y ; if isempty(firstCall),firstCall=1;end; 

if isempty(eps), eps=0; end;
if isempty(ewt), ewt=zeros(1,1); end;
if isempty(t), t=0; end;
if isempty(tout), tout=0; end;
if isempty(ierflg), ierflg=0; end;
if isempty(leniw), leniw=0; end;
if isempty(leniwx), leniwx=0; end;
if isempty(lenw), lenw=0; end;
if isempty(lenwx), lenwx=0; end;
if isempty(mint), mint=0; end;
if isempty(mstate), mstate=0; end;
if isempty(nde), nde=0; end;
if isempty(nfe), nfe=0; end;
if isempty(nje), nje=0; end;
if isempty(nstate), nstate=0; end;
if isempty(nstep), nstep=0; end;
if isempty(nx), nx=0; end;
if isempty(alfa), alfa=1.0d0; end;
if isempty(hmax), hmax=15.0d0; end;
if isempty(ierror), ierror=3; end;
if isempty(impl), impl=0; end;
if isempty(lenwmx), lenwmx=342; end;
if isempty(liwmx), liwmx=53; end;
if isempty(miter), miter=5; end;
if isempty(ml), ml=2; end;
if isempty(mu), mu=2; end;
if isempty(mxord), mxord=5; end;
if isempty(mxstep), mxstep=1000; end;
if isempty(n), n=3; end;
if isempty(nroot), nroot=0; end;
if isempty(ntask), ntask=1 ; end;
if isempty(work), work=zeros(1,lenwmx); end;
if isempty(y), y=zeros(1,n+1); end;
if isempty(iwork), iwork=zeros(1,liwmx); end;
if firstCall,   ewt(1)=[.00001d0];  end;
firstCall=0;
eps = d1mach(4).^(1.0d0./3.0d0);
ipass = 1;
y(4) = alfa;
t = 0.0d0;
y(1) = 10.0d0;
y(2) = 0.0d0;
y(3) = 10.0d0;
tout = 10.0d0;
mstate = 1;
lenw = 342;
[n,t,y,dumvar4,tout,mstate,eps,work,lenw,ierflg]=ddriv1(n,t,y,@ddf,tout,mstate,eps,work,lenw,ierflg);
nstep = fix(work(lenw-(n+50)+3));
nfe = fix(work(lenw-(n+50)+4));
nje = fix(work(lenw-(n+50)+5));
if( mstate~=2 )
if( kprint==1 )
writef(lun,[' While using DDRIV1, a solution                        was not&obtained.'  '\n ' , '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[' While using DDRIV1, a solution                        was not&obtained.']);
writef(lun,[' The values of parameters, resul                       ts, and&statistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g \n'], ' MSTATE = ' , mstate , ', Error number = ' ,ierflg);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' N ' , n , ', EPS ' , eps , ', LENW ' , lenw);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( abs(1.0d0-y(1).*1.5d0)>eps.^(2.0d0./3.0d0) ||abs(1.0d0-y(2).*3.0d0)>eps.^(2.0d0./3.0d0) || abs(1.0d0-y(3))>eps.^(2.0d0./3.0d0) ) ;
if( kprint==1 )
writef(lun,[' DDRIV1:The solution determine                         d is no&t accurate enough.'  '\n ' , '\n ' ]);
elseif( kprint==2 ) ;
writef(lun,[' DDRIV1:The solution determine                         d is no&t accurate enough.']);
writef(lun,[' The values of parameters, res                         ults, a&nd statistical quantities are:']);
writef(lun,['%s %0.15g \n'], ' EPS = ' , eps);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( kprint==2 ) ;
writef(lun,[' DDRIV1:The solution determine                         d met t&he expected values.'  '\n ' , '\n ' ]);
elseif( kprint==3 ) ;
writef(lun,[' DDRIV1:The solution determine                         d met t&he expected values.']);
writef(lun,[' The values of results are ']);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,[ '\n ' ]);
end;
xerclr;
nx = 201;
t = 0.0d0;
y(1) = 10.0d0;
y(2) = 0.0d0;
y(3) = 10.0d0;
y(4) = alfa;
tout = 10.0d0;
mstate = 1;
lenw = 342;
[nx,t,y,dumvar4,tout,mstate,eps,work,lenw,ierflg]=ddriv1(nx,t,y,@ddf,tout,mstate,eps,work,lenw,ierflg);
if( ierflg~=21 )
if( kprint==1 )
writef(lun,[' DDRIV1:An invalid parameter has                       not bee&n correctly detected.'  '\n ' , '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[' DDRIV1:An invalid parameter has                       not bee&n correctly detected.']);
writef(lun,['%s %0.15g \n'], ' The value of N was set to ' , nx);
writef(lun,['%s %0.15g %s %0.15g \n'], ' MSTATE = ' , mstate , ', Error number = ' ,ierflg);
writef(lun,[' The values of parameters, resul                       ts, and&statistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g \n'], ' EPS ' , eps , ', LENW ' , lenw);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( kprint==2 ) ;
writef(lun,[' DDRIV1:An invalid parameter has                       been co&rrectly detected.'  '\n ' , '\n ' ]);
elseif( kprint==3 ) ;
writef(lun,[' DDRIV1:An invalid parameter has                       been co&rrectly detected.']);
writef(lun,['%s %0.15g \n'], ' The value of N was set to ' , nx);
writef(lun,['%s %0.15g %s %0.15g \n'], ' MSTATE = ' , mstate , ', Error number = ' ,ierflg);
writef(lun,[ '\n ' ]);
end;
xerclr;
t = 0.0d0;
y(1) = 10.0d0;
y(2) = 0.0d0;
y(3) = 10.0d0;
y(4) = alfa;
mstate = 1;
tout = 10.0d0;
mint = 1;
lenw = 298;
leniw = 50;
[n,t,y,dumvar4,tout,mstate,nroot,eps,ewt,mint,work,lenw,iwork,leniw,dumvar15,ierflg]=ddriv2(n,t,y,@ddf,tout,mstate,nroot,eps,ewt,mint,work,lenw,iwork,leniw,@ddf,ierflg);
nstep = fix(iwork(3));
nfe = fix(iwork(4));
nje = fix(iwork(5));
if( mstate~=2 )
if( kprint==1 )
writef(lun,[' While using DDRIV2, a solution                        was not&obtained.'  '\n ' , '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[' While using DDRIV2, a solution                        was not&obtained.']);
writef(lun,['%s %0.15g %s %0.15g \n'], ' MSTATE = ' , mstate , ', Error number = ' ,ierflg);
writef(lun,[' The values of parameters, resul                       ts, and&statistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g \n'], ' EPS = ' , eps , ', EWT ' , ewt);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' MINT = ' , mint , ', LENW ' , lenw ,', LENIW ' , leniw);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( abs(1.0d0-y(1).*1.5d0)>eps.^(2.0d0./3.0d0) ||abs(1.0d0-y(2).*3.0d0)>eps.^(2.0d0./3.0d0) || abs(1.0d0-y(3))>eps.^(2.0d0./3.0d0) ) ;
if( kprint==1 )
writef(lun,[' DDRIV2:The solution determine                         d is no&t accurate enough.'  '\n ' , '\n ' ]);
elseif( kprint==2 ) ;
writef(lun,[' DDRIV2:The solution determine                         d is no&t accurate enough.']);
writef(lun,[' The values of parameters, res                         ults, a&nd statistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g \n'], ' EPS = ' , eps , ', EWT = ' , ewt);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( kprint==2 ) ;
writef(lun,[' DDRIV2:The solution determine                         d met t&he expected values.'  '\n ' , '\n ' ]);
elseif( kprint==3 ) ;
writef(lun,[' DDRIV2:The solution determine                         d met t&he expected values.']);
writef(lun,[' The values of results are ']);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,[ '\n ' ]);
end;
xerclr;
t = 0.0d0;
y(1) = 10.0d0;
y(2) = 0.0d0;
y(3) = 10.0d0;
y(4) = alfa;
tout = 10.0d0;
mstate = 1;
mint = 1;
lenwx = 1;
leniw = 50;
[n,t,y,dumvar4,tout,mstate,nroot,eps,ewt,mint,work,lenwx,iwork,leniw,dumvar15,ierflg]=ddriv2(n,t,y,@ddf,tout,mstate,nroot,eps,ewt,mint,work,lenwx,iwork,leniw,@ddf,ierflg);
if( ierflg~=32 )
if( kprint==1 )
writef(lun,[' DDRIV2:An invalid parameter has                       not bee&n correctly detected.'  '\n ' , '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[' DDRIV2:An invalid parameter has                       not bee&n correctly detected.']);
writef(lun,['%s %0.15g \n'], ' The value of LENW was set to ' , lenwx);
writef(lun,['%s %0.15g %s %0.15g \n'], ' MSTATE = ' , mstate , ', Error number = ' ,ierflg);
writef(lun,[' The values of parameters, resul                       ts, and&tatistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g %s %0.15g \n'], ' EPS ' , eps , ', MINT ' , mint , ', LENW ' ,lenw , ', LENIW ' , leniw);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( kprint==2 ) ;
writef(lun,[' DDRIV2:An invalid parameter has                       been co&rrectly detected.'  '\n ' , '\n ' ]);
elseif( kprint==3 ) ;
writef(lun,[' DDRIV2:An invalid parameter has                       been co&rrectly detected.']);
writef(lun,['%s %0.15g \n'], ' The value of LENW was set to ' , lenwx);
writef(lun,['%s %0.15g %s %0.15g \n'], ' MSTATE = ' , mstate , ', Error number = ' ,ierflg);
writef(lun,[ '\n ' ]);
end;
xerclr;
t = 0.0d0;
y(1) = 10.0d0;
y(2) = 0.0d0;
y(3) = 10.0d0;
y(4) = alfa;
nstate = 1;
tout = 10.0d0;
mint = 2;
lenw = 301;
leniw = 53;
[n,t,y,dumvar4,nstate,tout,ntask,nroot,eps,ewt,ierror,mint,miter,impl,ml,mu,mxord,hmax,work,lenw,iwork,leniw,dumvar23,dumvar24,nde,mxstep,dumvar27,dumvar28,ierflg]=ddriv3(n,t,y,@ddf,nstate,tout,ntask,nroot,eps,ewt,ierror,mint,miter,impl,ml,mu,mxord,hmax,work,lenw,iwork,leniw,@ddf,@ddf,nde,mxstep,@ddf,@ddf,ierflg);
nstep = fix(iwork(3));
nfe = fix(iwork(4));
nje = fix(iwork(5));
if( nstate~=2 )
if( kprint==1 )
writef(lun,[' While using DDRIV3, a solution                        was not&obtained.'  '\n ' , '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[' While using DDRIV3, a solution                        was not&obtained.']);
writef(lun,['%s %0.15g %s %0.15g \n'], ' MSTATE = ' , mstate , ', Error number = ' ,ierflg);
writef(lun,[' The values of parameters, resul                       ts, and&statistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' EPS = ' , eps , ', EWT = ' , ewt ,', IERROR = ' , ierror);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' MINT = ' , mint , ', MITER = ' , miter ,', IMPL = ' , impl);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( abs(1.0d0-y(1).*1.5d0)>eps.^(2.0d0./3.0d0) ||abs(1.0d0-y(2).*3.0d0)>eps.^(2.0d0./3.0d0) || abs(1.0d0-y(3))>eps.^(2.0d0./3.0d0) ) ;
if( kprint==1 )
writef(lun,[' DDRIV3:The solution determine                         d is no&t accurate enough.'  '\n ' , '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[' DDRIV3:The solution determine                         d is no&t accurate enough.']);
writef(lun,[' The values of parameters, res                         ults, a&nd statistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' EPS = ' , eps , ', EWT = ' , ewt ,', IERROR = ' , ierror);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' MINT = ' , mint , ', MITER = ' , miter ,', IMPL = ' , impl);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( kprint==2 ) ;
writef(lun,[' DDRIV3:The solution determine                         d met t&he expected values.'  '\n ' , '\n ' ]);
elseif( kprint==3 ) ;
writef(lun,[' DDRIV3:The solution determine                         d met t&he expected values.']);
writef(lun,[' The values of results are ']);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,[ '\n ' ]);
end;
xerclr;
t = 0.0d0;
y(1) = 10.0d0;
y(2) = 0.0d0;
y(3) = 10.0d0;
y(4) = alfa;
nstate = 1;
tout = 10.0d0;
mint = 2;
lenw = 301;
leniwx = 1;
[n,t,y,dumvar4,nstate,tout,ntask,nroot,eps,ewt,ierror,mint,miter,impl,ml,mu,mxord,hmax,work,lenw,iwork,leniwx,dumvar23,dumvar24,nde,mxstep,dumvar27,dumvar28,ierflg]=ddriv3(n,t,y,@ddf,nstate,tout,ntask,nroot,eps,ewt,ierror,mint,miter,impl,ml,mu,mxord,hmax,work,lenw,iwork,leniwx,@ddf,@ddf,nde,mxstep,@ddf,@ddf,ierflg);
if( ierflg~=33 )
if( kprint==1 )
writef(lun,[' DDRIV3:An invalid parameter has                       not bee&n correctly detected.'  '\n ' , '\n ' ]);
elseif( kprint>=2 ) ;
writef(lun,[' DDRIV3:An invalid parameter has                       not bee&n correctly detected.']);
writef(lun,['%s %0.15g \n'], ' The value of LENIW was set to ' , leniwx);
writef(lun,['%s %0.15g %s %0.15g \n'], ' NSTATE = ' , nstate , ', Error number = ' ,ierflg);
writef(lun,[' The values of parameters, resul                       ts, and&statistical quantities are:']);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' EPS = ' , eps , ', EWT = ' , ewt ,', IERROR = ' , ierror);
writef(lun,['%s %0.15g %s %0.15g %s %0.15g \n'], ' MINT = ' , mint , ', MITER = ' , miter ,', IMPL = ' , impl);
writef(lun,['%s %0.15g \n'], ' T ' , t);
writef(lun,['%s %0.15g \n'], ' Y(1) ' , y(1));
writef(lun,['%s %0.15g \n'], ' Y(2) ' , y(2));
writef(lun,['%s %0.15g \n'], ' Y(3) ' , y(3));
writef(lun,['%s %0.15g \n'], ' Number of steps taken is  ' , nstep);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the right hand side is  ', nfe);
writef(lun,['%s %0.15g \n'],' Number of evaluations of the Jacobian matrix is  ', nje);
writef(lun,[ '\n ' , '\n ' ]);
end;
ipass = 0;
elseif( kprint==2 ) ;
writef(lun,[' DDRIV3:An invalid parameter has                       been co&rrectly detected.'  '\n ' , '\n ' ]);
elseif( kprint==3 ) ;
writef(lun,[' DDRIV3:An invalid parameter has                       been co&rrectly detected.']);
writef(lun,['%s %0.15g \n'], ' The value of LENIW was set to ' , leniwx);
writef(lun,['%s %0.15g %s %0.15g \n'], ' NSTATE = ' , nstate , ', Error number = ' ,ierflg);
writef(lun,[ '\n ' ]);
end;
xerclr;
end %subroutine ddqck

Contact us at files@mathworks.com