End of file
Contents
Index

F 16 Numerical Cubature

F 16.3 Newton-Cotes Cubature Formulas for Rectangles


      SUBROUTINE K4NECN(USERF,A,B,IP,C,D,IQ,METHOD,MOLD,CREC,
     +                  ESTDIV,DIVIAT,WORK,IERR,IUFCLL)
C
C*****************************************************************
C                                                                *
C Cubature for rectangular regions using the NEWTON-COTES        *
C formulas:                                                      *
C                                                                *
C The FUNCTION USERF(X,Y) is integrated over the rectangle       *
C [A,B] x [C,D] using the summed NEWTON-COTES formulas.          *
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 METHOD  : INTEGER designating the method used:                 *
C                     1: trapezoidal rule                        *
C                     2: SIMPSON rule                            *
C                     3: 3/8-rule                                *
C                     4: 4/90-rule                               *
C                     5: 5/288-rule                              *
C                     6: 6/840-rule                              *
C                     7: 7/17280-rule                            *
C MOLD    : INTEGER, the number of the method used at a previous *
C           call of this subroutine. On first call we must have  *
C           that MOLD does not equal METHOD !                    *
C           In a subsequent call of K4NECN with METHOD=MOLD      *
C           the internal initializing of parameters is skipped.  *
C ESTDIV  : LOGICAL variable; If ESTDIV=TRUE we compute an error *
C           estimate, if ESTDIV=FALSE we do not.                 *
C WORK    : DOUBLE PRECISION vector WORK(0:METHOD+2)             *
C           If METHOD=MOLD, WORK must contain the constants      *
C           initialized for the proper method.                   *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C MOLD    : INTEGER, the number of the method used               *
C CREC    : DOUBLE PRECISION value for the integral              *
C DIVIAT  : DOUBLE PRECISION error estimate                      *
C           If ESTDIV=TRUE, we perform an additional cubature    *
C           with halved stepsize for error estimation.           *
C WORK    : DOUBLE PRECISION vector WORK(0:METHOD+2),            *
C           contains the constants for the method used.          *
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 method number erroneous      *
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 VARIABLES:                                               *
C =================                                              *
C I,J,K   : INTEGER loop variables                               *
C KMAX    : INTEGER, the number of cubature passes desired       *
C IPX     : INTEGER, number of intervals in X-direction          *
C IPY     : INTEGER, number of intervals in Y-direction          *
C DBLEI   : DOUBLE PRECISION value for I                         *
C HX      : DOUBLE PRECISION step size in X-direction            *
C HY      : DOUBLE PRECISION step size in Y-direction            *
C CRECH   : DOUBLE PRECISION auxiliary variable                  *
C                                                                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  required subroutines: K4INIT, GRIDOT                          *
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:METHOD+2),A,B,C,D,CREC,CRECH,DIVIAT,
     +                 HX,HY,DBLEI,GRIDOT,USERF
C
C Initialize LOGICAL variable ESTDIV
C
      LOGICAL ESTDIV
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 (METHOD .LT. 1 .OR. METHOD .GT. 7) THEN
         IERR=3
         RETURN
      ELSEIF (A .EQ. B .OR. C .EQ. D) THEN
         IERR=4
         RETURN
      ELSE
         IERR=0
      ENDIF
C
C Initialize as needed
C
      IF (METHOD .NE. MOLD) THEN
        CALL K4INIT(METHOD,WORK)
        MOLD=METHOD
      ENDIF
C
C Set maximal number of cubature passes
C
      IF (ESTDIV) THEN
        KMAX=2
      ELSE
        KMAX=1
      ENDIF
C
C Determine number of X and Y sub-intervals
C
      DO 10 K=1,KMAX
         IPX=K*IP*METHOD
         IQY=K*IQ*METHOD
C
C Initialize CREC
C
         CREC=0.0D0
C
C Find step sizes in both X- and Y-directions
C
         HX=(B-A)/DBLE(IPX)
         HY=(D-C)/DBLE(IQY)
C
C Compute an approximate value of the integral
C
         DO 20 I=0,IPX
            DBLEI=DBLE(I)
            DO 30 J=0,IQY
               CREC=CREC+GRIDOT(I,J,WORK,METHOD,IPX,IQY)*
     +              USERF(A+DBLEI*HX,C+DBLE(J)*HY)
               IUFCLL=IUFCLL+1
30          CONTINUE
20       CONTINUE
         CREC=CREC*HX*HY*WORK(METHOD+1)
C
C In case error estimate is desired, store first value for the integral
C
         IF (ESTDIV .AND. K .EQ. 1) CRECH=CREC
10    CONTINUE
C
C Estimate the error
C
      IF (ESTDIV) DIVIAT=(CREC-CRECH)/(2.0D0**WORK(METHOD+2)-1.0D0)
C
C Return to calling program
C
      RETURN
      END
C
C

      DOUBLE PRECISION FUNCTION GRIDOT(I,J,WORK,METHOD,IPX,IQY)
C
C*****************************************************************
C                                                                *
C FUNCTION that determines the weights at the nodes.             *
C                                                                *
C In summed Newton-Cotes cubature the functional values are      *
C given different weights that depend on their position on the   *
C boundary, center or at the join of two rectangles.             *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C I       : INTEGER, the number of the node in X-direction       *
C J       : INTEGER, the number of the node in Y-direction       *
C WORK    : DOUBLE PRECISION vector WORK(0:METHOD), containing   *
C           the constants for the method                         *
C METHOD  : INTEGER designating the method chosen:               *
C                     1: trapezoidal rule                        *
C                     2: SIMPSON rule                            *
C                     3: 3/8-rule                                *
C                     4: 4/90-rule                               *
C                     5: 5/288-rule                              *
C                     6: 6/840-rule                              *
C                     7: 7/17280-rule                            *
C IPX     : INTEGER number of intervals used in X-direction      *
C IPY     : INTEGER number of intervals used in Y-direction      *
C                                                                *
C                                                                *
C LOCAL VARIABLE:                                                *
C ================                                               *
C K       : INTEGER auxiliary variable                           *
C                                                                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author   : Volker Krüger                                      *
C  Date     : 06.121991                                         *
C  Source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
C Declarations
C
      DOUBLE PRECISION WORK(0:METHOD)
C
C Determine the weights for the nodes
C
      K=MOD(I,METHOD)
      GRIDOT=WORK(K)
      IF (K.EQ.0 .AND. I.GT.0 .AND. I.LT.IPX) GRIDOT=2.0D0*GRIDOT
      K=MOD(J,METHOD)
      GRIDOT=GRIDOT*WORK(K)
      IF (K.EQ.0 .AND. J.GT.0 .AND. J.LT.IQY) GRIDOT=2.0D0*GRIDOT
C
C Return to calling program
C
      RETURN
      END
C
C

      SUBROUTINE K4INIT(METHOD,WORK)
C
C*****************************************************************
C                                                                *
C Subroutine that initializes the constants for the various      *
C methods.                                                       *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C METHOD  : INTEGER, the number designating the method:          *
C                     1: trapezoidal rule                        *
C                     2: SIMPSON rule                            *
C                     3: 3/8 rule                                *
C                     4: 4/90 rule                               *
C                     5: 5/288 rule                              *
C                     6: 6/840 rule                              *
C                     7: 7/17280 rule                            *
C                                                                *
C                                                                *
C OUTPUT PARAMETER:                                              *
C =================                                              *
C WORK    : DOUBLE PRECISION vector WORK(0:METHOD+2),            *
C           containing the constants for the method              *
C                                                                *
C                                                                *
C LOCAL VARIABLES:                                               *
C ================                                               *
C I       : INTEGER loop counter                                 *
C J       : INTEGER auxiliary variable                           *
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 WORK(0:METHOD+2)
C
C Initialize upper half of WORK depending on method
C
      IF (METHOD .EQ. 1) THEN
         WORK(0)=1.0D0
         WORK(METHOD+1)=2.0D0
         WORK(METHOD+2)=2.0D0
         J=1
      ELSEIF (METHOD .EQ. 2) THEN
         WORK(0)=1.0D0
         WORK(1)=4.0D0
         WORK(METHOD+1)=6.0D0
         WORK(METHOD+2)=4.0D0
         J=2
      ELSEIF (METHOD .EQ. 3) THEN
         WORK(0)=1.0D0
         WORK(1)=3.0D0
         WORK(METHOD+1)=8.0D0
         WORK(METHOD+2)=4.0D0
         J=2
      ELSEIF (METHOD .EQ. 4) THEN
         WORK(0)=7.0D0
         WORK(1)=32.0D0
         WORK(2)=12.0D0
         WORK(METHOD+1)=90.0D0
         WORK(METHOD+2)=6.0D0
         J=3
      ELSEIF (METHOD .EQ. 5) THEN
         WORK(0)=19.0D0
         WORK(1)=75.0D0
         WORK(2)=50.0D0
         WORK(METHOD+1)=288.0D0
         WORK(METHOD+2)=6.0D0
         J=3
      ELSEIF (METHOD .EQ. 6) THEN
         WORK(0)=41.0D0
         WORK(1)=216.0D0
         WORK(2)=27.0D0
         WORK(3)=272.0D0
         WORK(METHOD+1)=840.0D0
         WORK(METHOD+2)=8.0D0
         J=4
      ELSEIF (METHOD .EQ. 7) THEN
         WORK(0)=751.0D0
         WORK(1)=3577.0D0
         WORK(2)=1323.0D0
         WORK(3)=2989.0D0
         WORK(METHOD+1)=17280.0D0
         WORK(METHOD+2)=8.0D0
         J=4
      ENDIF
C
C Determine lower half symmetrically
C
      DO 10 I=J,METHOD
         WORK(I)=WORK(METHOD-I)
10    CONTINUE
C
C Determine the multiplication factors for the summed values
C in the cubature formula
C
      WORK(METHOD+1)=DBLE(METHOD)/WORK(METHOD+1)
      WORK(METHOD+1)=WORK(METHOD+1)*WORK(METHOD+1)
C
C Return to calling program
C
      RETURN
      END


Begin of file
Contents
Index