End of file
Contents
Index
SUBROUTINE K4RORI(USERF,A,B,IP,C,D,IQ,N,CREC,DIVIAT,WORK,
+ IERR,IUFCLL)
C
C*****************************************************************
C *
C Cubature over rectangular regions using the summed ROMBERG- *
C RICHARDSON method. *
C *
C By using a simplified summed trapezoidal rule, we can *
C approximate the integral of the FUNCTION USERF(X,Y) over *
C the rectangle [A,B] x [C,D] for the ROMBERG sequence of step *
C sizes. After this we can obtain a better approximation of the *
C integral by RICHARDSON extrapolation. For H = B - A or D - C, *
C respectively, we use the step sizes: *
C H * (1/2, 1/4, 1/8, 1/16, 1/32, 1/64, 1/128, 1/256 ...) *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C USERF : user defined FUNCTION USERF(X,Y), whose integral is *
C to be computed. *
C The FUNCTION USERF must be declared as EXTERNAL in *
C the calling program. *
C The FUNCTION should have the following form: *
C DOUBLE PRECISION FUNCTION USERF(X,Y) *
C DOUBLE PRECISION X,Y *
C . *
C . *
C . *
C USERF=F(X,Y) *
C . *
C . *
C . *
C RETURN *
C STOP *
C *
C A : DOUBLE PRECISION left endpoint in X-direction *
C B : DOUBLE PRECISION right endpoint in X-direction *
C IP : INTEGER, the number of intervals in X-direction *
C C : DOUBLE PRECISION lower endpoint in Y-direction *
C D : DOUBLE PRECISION upper endpoint in Y-direction *
C IQ : INTEGER, the number of intervals in Y-direction *
C N : INTEGER, number of summed trapezoidal cubatures, *
C N > 1 *
C WORK : DOUBLE PRECISION storage vector WORK(0:METHOD+2) *
C *
C *
C OUTPUT PARAMETERS: *
C ================== *
C CREC : DOUBLE PRECISION approximate value for the integral *
C DIVIAT : DOUBLE PRECISION error estimate *
C IERR : error parameter: IERR=0 all is ok *
C IERR=1 number of intervals in *
C X-direction erroneous *
C IERR=2 number of intervals in *
C Y-direction erroneous *
C IERR=3 N <= 1 *
C IERR=4 integrating over an interval *
C of length zero. *
C IUFCLL : INTEGER, the number of functional evaluations *
C performed. *
C *
C *
C LOCAL VARIABLE: *
C ================= *
C J : INTEGER loop variable *
C *
C *
C----------------------------------------------------------------*
C *
C required subroutines: K4ROST, RORIEX *
C *
C*****************************************************************
C *
C Author : Volker Krüger *
C Date : 06.12.1991 *
C Source : FORTRAN 77 *
C *
C*****************************************************************
C
C Declarations
C
DOUBLE PRECISION WORK(0:N-1,2),A,B,C,D,CREC,DIVIAT
EXTERNAL USERF
C
C Initialize IUFCLL
C
IUFCLL=0
C
C Check input data
C
IF(IP .LT. 1) THEN
IERR=1
RETURN
ELSEIF(IQ .LT. 1) THEN
IERR=2
RETURN
ELSEIF(N .LT. 2) THEN
IERR=3
RETURN
ELSEIF(A .EQ. B .OR. C .EQ. D) THEN
IERR=4
RETURN
ELSE
IERR=0
ENDIF
C
C Execute trapezoidal cubatures for the ROMBERG sequence of step sizes
C
DO 10 J=0,N-1
CALL K4ROST(USERF,A,B,IP,C,D,IQ,J,WORK(J,1),IUFCLL)
10 CONTINUE
C
C Approximate and estimate the error via RICHARDSON extrapolation
C
CALL RORIEX(WORK(0,1),WORK(0,2),N,2,CREC,DIVIAT)
C
C Return to calling program
C
RETURN
END
C
C
SUBROUTINE RORIEX(ROMB,WORK,N,M,VAL,ERREST)
C
C*****************************************************************
C *
C RICHARDSON extrapolation for a given ROMBERG sequence. *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C ROMB : DOUBLE PRECISION vector ROMB(0:N-1), containing *
C the ROMBERG sequence *
C WORK : DOUBLE PRECISION storage vector WORK(0:N-1) *
C N : INTEGER, the number of elements in ROMB *
C M : INTEGER, the order of the method *
C *
C *
C OUTPUT PARAMETERS: *
C ================== *
C VAL : DOUBLE PRECISION, final value of the extrapolation *
C ERREST : DOUBLE PRECISION error estimate for VAL *
C *
C *
C LOCALE VARIABLES: *
C ================= *
C K,J : INTEGER loop counters *
C S : DOUBLE PRECISION ] auxiliary *
C P : DOUBLE PRECISION ] variables *
C *
C *
C----------------------------------------------------------------*
C *
C subroutines required: none *
C *
C*****************************************************************
C *
C Author : Volker Krüger *
C Date : 06.12.1991 *
C Source : FORTRAN 77 *
C *
C*****************************************************************
C
C Declarations
C
DOUBLE PRECISION ROMB(0:N-1),WORK(0:N-1),VAL,ERREST,P,S
C
C Store ROMBERG sequence in auxiliary vector
C
DO 10 K=0,N-1
WORK(K)=ROMB(K)
10 CONTINUE
C
C Initialize auxiliary variables S and P
C
S=2.0D0**(DBLE(M))
P=S
C
C RICHARDSON extrapolation
C
DO 20 K=1,N-1
DO 30 J=0,N-K-1
WORK(J)=(P*WORK(J+1)-WORK(J))/(P-1.0D0)
30 CONTINUE
P=P*S
20 CONTINUE
C
C Set up values for the extrapolation
C
VAL=WORK(0)
C
C Error estimation
C
ERREST=DABS(WORK(0)-WORK(1))
C
C Return to calling program
C
RETURN
END
C
C
SUBROUTINE K4ROST(USERF,A,B,IP,C,D,IQ,J,CROST,IUFCLL)
C
C*****************************************************************
C *
C Cubature over rectangular regions using the summed trapezoidal *
C rule in order to compute the Jth element of a ROMBERG sequence.*
C *
C *
C INPUT PARAMETERS: *
C ================= *
C USERF : user defined FUNCTION USERF(X,Y), whose integral is *
C to be computed. *
C The FUNCTION USERF must be declared as EXTERNAL in *
C the calling program. *
C The FUNCTION should have the following form: *
C DOUBLE PRECISION FUNCTION USERF(X,Y) *
C DOUBLE PRECISION X,Y *
C . *
C . *
C . *
C USERF=F(X,Y) *
C . *
C . *
C . *
C RETURN *
C STOP *
C *
C A : DOUBLE PRECISION left endpoint in X-direction *
C B : DOUBLE PRECISION right endpoint in X-direction *
C IP : INTEGER, the number of intervals in X-direction *
C C : DOUBLE PRECISION lower endpoint in Y-direction *
C D : DOUBLE PRECISION upper endpoint in Y-direction *
C IQ : INTEGER, the number of intervals in Y-direction *
C J : INTEGER, the index of the element in the ROMBERG *
C sequence *
C IUFCLL : INTEGER, the number of previous function evaluations *
C *
C *
C OUTPUT PARAMETERS: *
C ================== *
C CROST : DOUBLE PRECISION approximate value for the integral *
C IUFCLL : INTEGER, the number of function evaluations *
C *
C *
C LOKALE VARIABLEN: *
C ================= *
C I,K : INTEGER loop counters *
C HAB : DOUBLE PRECISION step size in X-direction *
C HCD : DOUBLE PRECISION step size in X-direction *
C FAC : DOUBLE PRECISION weight for the node *
C ABNUM : DOUBLE PRECISION value for the number of intervals *
C in X-direction *
C CDNUM : DOUBLE PRECISION value for the number of intervals *
C in Y-direction *
C DJ : DOUBLE PRECISION varible used to determine the number*
C of intervals *
C DBLEI : DOUBLE PRECISION value for I *
C IABNUM : INTEGER value for ABNUM *
C ICDNUM : INTEGER value for CDNUM *
C *
C *
C----------------------------------------------------------------*
C *
C subroutines required: none *
C *
C*****************************************************************
C *
C Author : Volker Krüger *
C Date : 06.12.1991 *
C Source : FORTRAN 77 *
C *
C*****************************************************************
C
C Declarations
C
DOUBLE PRECISION A,B,C,D,CROST,USERF,HAB,HCD,FAC,ABNUM,
+ CDNUM,DJ,DBLEI
C
C Factor to determine number of intervals
C
DJ=2.0D0**(DBLE(J))
C
C Number of intervals in both X- and Y-direction
C
ABNUM=DJ*DBLE(IP)
CDNUM=DJ*DBLE(IQ)
IABNUM=INT(ABNUM)
ICDNUM=INT(CDNUM)
C
C Step size in X- and Y-direction
C
HAB=(B-A)/ABNUM
HCD=(D-C)/CDNUM
\hbox{\JDhspace\verb`
C
C Initialize CROST
C
CROST=0.0D0
C
C Find a value for the integral via the summed trapezoidal rule
C
DO 10 I=0,IABNUM
DBLEI=DBLE(I)
DO 20 K=0,ICDNUM
C
C Determine weights
C
FAC=1.0D0
IF(I .GT. 0 .AND. I .LT. IABNUM) FAC=2.0D0
IF(K .GT. 0 .AND. K .LT. ICDNUM) FAC=2.0D0*FAC
CROST=CROST+FAC*USERF(A+HAB*DBLEI,C+HCD*DBLE(K))
IUFCLL=IUFCLL+1
20 CONTINUE
10 CONTINUE
CROST=0.25D0*HAB*HCD*CROST
C
C Return to calling program
C
RETURN
END
Begin of file
Contents
Index