| [f,a,b,c,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqawc(f,a,b,c,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work); |
function [f,a,b,c,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work]=dqawc(f,a,b,c,epsabs,epsrel,result,abserr,neval,ier,limit,lenw,last,iwork,work);
%***BEGIN PROLOGUE DQAWC
%***PURPOSE The routine calculates an approximation result to a
% Cauchy principal value I = INTEGRAL of F*W over (A,B)
% (W(X) = 1/((X-C), C.NE.A, C.NE.B), hopefully satisfying
% following claim for accuracy
% ABS(I-RESULT).LE.MAX(EPSABE,EPSREL*ABS(I)).
%***LIBRARY SLATEC (QUADPACK)
%***CATEGORY H2A2A1, J4
%***TYPE doubleprecision (QAWC-S, DQAWC-D)
%***KEYWORDS AUTOMATIC INTEGRATOR, CAUCHY PRINCIPAL VALUE,
% CLENSHAW-CURTIS METHOD, GLOBALLY ADAPTIVE, QUADPACK,
% QUADRATURE, SPECIAL-PURPOSE
%***AUTHOR Piessens, Robert
% Applied Mathematics and Programming Division
% K. U. Leuven
% de Doncker, Elise
% Applied Mathematics and Programming Division
% K. U. Leuven
%***DESCRIPTION
%
% Computation of a Cauchy principal value
% Standard fortran subroutine
% doubleprecision version
%
%
% PARAMETERS
% ON ENTRY
% F - doubleprecision
% function subprogram defining the integrand
% function F(X). The actual name for F needs to be
% declared E X T E R N A L in the driver program.
%
% A - doubleprecision
% Under limit of integration
%
% B - doubleprecision
% Upper limit of integration
%
% C - Parameter in the weight function, C.NE.A, C.NE.B.
% If C = A or C = B, the routine will end with
% IER = 6 .
%
% EPSABS - doubleprecision
% Absolute accuracy requested
% EPSREL - doubleprecision
% Relative accuracy requested
% If EPSABS.LE.0
% and EPSREL.LT.MAX(50*REL.MACH.ACC.,0.5D-28),
% the routine will end with IER = 6.
%
% ON RETURN
% RESULT - doubleprecision
% Approximation to the integral
%
% ABSERR - doubleprecision
% Estimate or the modulus of the absolute error,
% Which should equal or exceed ABS(I-RESULT)
%
% NEVAL - Integer
% Number of integrand evaluations
%
% IER - Integer
% IER = 0 Normal and reliable termination of the
% routine. It is assumed that the requested
% accuracy has been achieved.
% IER.GT.0 Abnormal termination of the routine
% the estimates for integral and error are
% less reliable. It is assumed that the
% requested accuracy has not been achieved.
% ERROR MESSAGES
% IER = 1 Maximum number of subdivisions allowed
% has been achieved. One can allow more sub-
% divisions by increasing the value of LIMIT
% (and taking the according dimension
% adjustments into account). However, if
% this yields no improvement it is advised
% to analyze the integrand in order to
% determine the integration difficulties.
% If the position of a local difficulty
% can be determined (e.g. SINGULARITY,
% DISCONTINUITY within the interval) one
% will probably gain from splitting up the
% interval at this point and calling
% appropriate integrators on the subranges.
% = 2 The occurrence of roundoff error is detec-
% ted, which prevents the requested
% tolerance from being achieved.
% = 3 Extremely bad integrand behaviour occurs
% at some points of the integration
% interval.
% = 6 The input is invalid, because
% C = A or C = B or
% (EPSABS.LE.0 and
% EPSREL.LT.MAX(50*REL.MACH.ACC.,0.5D-28))
% or LIMIT.LT.1 or LENW.LT.LIMIT*4.
% RESULT, ABSERR, NEVAL, LAST are set to
% zero. Except when LENW or LIMIT is
% invalid, IWORK(1), WORK(LIMIT*2+1) and
% WORK(LIMIT*3+1) are set to zero, WORK(1)
% is set to A and WORK(LIMIT+1) to B.
%
% DIMENSIONING PARAMETERS
% LIMIT - Integer
% Dimensioning parameter for IWORK
% LIMIT determines the maximum number of subintervals
% in the partition of the given integration interval
% (A,B), LIMIT.GE.1.
% If LIMIT.LT.1, the routine will end with IER = 6.
%
% LENW - Integer
% Dimensioning parameter for WORK
% LENW must be at least LIMIT*4.
% If LENW.LT.LIMIT*4, the routine will end with
% IER = 6.
%
% LAST - Integer
% On return, LAST equals the number of subintervals
% produced in the subdivision process, which
% determines the number of significant elements
% actually in the WORK ARRAYS.
%
% WORK ARRAYS
% IWORK - Integer
% Vector of dimension at least LIMIT, the first K
% elements of which contain pointers
% to the error estimates over the subintervals,
% such that WORK(LIMIT*3+IWORK(1)), ... ,
% WORK(LIMIT*3+IWORK(K)) form a decreasing
% sequence, with K = LAST if LAST.LE.(LIMIT/2+2),
% and K = LIMIT+1-LAST otherwise
%
% WORK - doubleprecision
% Vector of dimension at least LENW
% On return
% WORK(1), ..., WORK(LAST) contain the left
% end points of the subintervals in the
% partition of (A,B),
% WORK(LIMIT+1), ..., WORK(LIMIT+LAST) contain
% the right end points,
% WORK(LIMIT*2+1), ..., WORK(LIMIT*2+LAST) contain
% the integral approximations over the subintervals,
% WORK(LIMIT*3+1), ..., WORK(LIMIT*3+LAST)
% contain the error estimates.
%
%***REFERENCES (NONE)
%***ROUTINES CALLED DQAWCE, XERMSG
%***REVISION HISTORY (YYMMDD)
% 800101 DATE WRITTEN
% 890831 Modified array declarations. (WRB)
% 890831 REVISION DATE from Version 3.2
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
%***end PROLOGUE DQAWC
%
persistent l1 l2 l3 lvl ;
if isempty(lvl), lvl=0; end;
if isempty(l1), l1=0; end;
if isempty(l2), l2=0; end;
if isempty(l3), l3=0; end;
%
iwork_shape=size(iwork);iwork=reshape(iwork,1,[]);
work_shape=size(work);work=reshape(work,1,[]);
%
%
% CHECK VALIDITY OF LIMIT AND LENW.
%
%***FIRST EXECUTABLE STATEMENT DQAWC
ier = 6;
neval = 0;
last = 0;
result = 0.0d+00;
abserr = 0.0d+00;
if( limit>=1 && lenw>=limit.*4 )
%
% PREPARE CALL FOR DQAWCE.
%
l1 = fix(limit + 1);
l2 = fix(limit + l1);
l3 = fix(limit + l2);
[f,a,b,c,epsabs,epsrel,limit,result,abserr,neval,ier,dumvar12,dumvar13,dumvar14,dumvar15,iwork,last]=dqawce(f,a,b,c,epsabs,epsrel,limit,result,abserr,neval,ier,work(sub2ind(size(work),max(1,1)):end),work(sub2ind(size(work),max(l1,1)):end),work(sub2ind(size(work),max(l2,1)):end),work(sub2ind(size(work),max(l3,1)):end),iwork,last); dumvar12i=find((work(sub2ind(size(work),max(1,1)):end))~=(dumvar12));dumvar13i=find((work(sub2ind(size(work),max(l1,1)):end))~=(dumvar13));dumvar14i=find((work(sub2ind(size(work),max(l2,1)):end))~=(dumvar14));dumvar15i=find((work(sub2ind(size(work),max(l3,1)):end))~=(dumvar15)); work(1-1+dumvar12i)=dumvar12(dumvar12i); work(l1-1+dumvar13i)=dumvar13(dumvar13i); work(l2-1+dumvar14i)=dumvar14(dumvar14i); work(l3-1+dumvar15i)=dumvar15(dumvar15i);
%
% CALL ERROR HANDLER IF NECESSARY.
%
lvl = 0;
end;
if( ier==6 )
lvl = 1;
end;
if( ier~=0 )
[dumvar1,dumvar2,dumvar3,ier,lvl]=xermsg('SLATEC','DQAWC','ABNORMAL RETURN',ier,lvl);
end;
iwork_shape=zeros(iwork_shape);iwork_shape(:)=iwork(1:numel(iwork_shape));iwork=iwork_shape;
work_shape=zeros(work_shape);work_shape(:)=work(1:numel(work_shape));work=work_shape;
end
%DECK DQAWFE
|
|