End of file
Contents
Index

      SUBROUTINE K4GAUV(USERF,X,NX,Y,NY,METHOD,MOLD,CREC,
     +                  ESTDIV,DIVIAT,WORK,IERR,IUFCLL)
C
C*****************************************************************
C                                                                *
C Cubature over rectangles using NEWTON-COTES formulas for       *
C GAUSSIAN nodes:                                                *
C                                                                *
C The FUNCTION USERF(X,Y) shall be integrated using summed       *
C GAUSSIAN formulas for the rectangle [A,B] x [C,D].             *
C The sub-rectangles to be used are given via the vectors        *
C X and Y.                                                       *
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 X       : DOUBLE PRECISION vector X(0:NX) containing the X     *
C           partition of [A,B].                                  *
C           A = X(0) < X(1) < ... < X(NX) = B                    *
C NX      : number of intervals in X-direction, NX > 0           *
C Y       : DOUBLE PRECISION vector Y(0:NY) containing the Y     *
C           partition of [C,D].                                  *
C           C = Y(0) < Y(1) < ... < Y(NY) = D                    *
C NY      : number of intervals in Y-direction, NY > 0           *
C METHOD  : INTEGER indicating method used, 0 <= METHOD <= 7     *
C MOLD    : INTEGER, the number in METHOD at the previous call.  *
C           Upon first call we must have: MOLD different from    *
C           METHOD                                               *
C           If K4NECN is called repeatedly with METHOD=MOLD the  *
C           internal initializing of parameters is skipped.      *
C ESTDIV  : LOGICAL variable, indicates whether error estimate   *
C           is to be computed (ESTDIV=TRUE) or not (ESTDIV=FALSE)*
C WORK    : 2-dimensional DOUBLE PRECISION array                 *
C           WORK(3,0:METHOD-1). If METHOD=MOLD this array must   *
C           contain the initializing parameters for the method.  *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C MOLD    : INTEGER indicating method used                       *
C CREC    : DOUBLE PRECISION value for the integral              *
C WORK    : 2-dimensional DOUBLE PRECISION array WORK(2,0:METHOD)*
C           containing the constants for the method              *
C DIVIAT  : DOUBLE PRECISION error estimate                      *
C           If ESTDIV=TRUE the error is estimated by one extra   *
C           cubature for the halved step size.                   *
C IERR    : error parameter: IERR=0 all is ok                    *
C                            IERR=1 X-interval of length zero    *
C                            IERR=2 Y-interval of length zero    *
C                            IERR=3 Number of method erroneous   *
C                            IERR=4 NX < 1 or NY < 1             *
C IUFCLL  : INTEGER, the number of functional evaluations        *
C                                                                *
C                                                                *
C LOCAL VARIABLES:                                               *
C =================                                              *
C I, J, K : INTEGER, loop counters                               *
C II, JJ  : INTEGER, loop counters                               *
C I1, J1  : INTEGER, loop counters                               *
C KMAX    : INTEGER number of cubature passes                    *
C DBLEX   : DOUBLE PRECISION value for K                         *
C HX      : DOUBLE PRECISION step size in X-direction            *
C HY      : DOUBLE PRECISION step size in Y-direction            *
C HXM     : DOUBLE PRECISION mid-point of X-interval             *
C HYM     : DOUBLE PRECISION mid-point of Y-interval             *
C CRECH   : DOUBLE PRECISION variable used for error estimation  *
C FAC     : DOUBLE PRECISION variable used for CREC              *
C HELPF   : DOUBLE PRECISION variable used for CREC              *
C                                                                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Subroutines required: K4GINI                                  *
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(2,0:METHOD),X(0:NX),Y(0:NY),CREC,
     +                 CRECH,DIVIAT,HX,HY,HXM,HYM,DBLEK,FAC,HELPF,
     +                 USERF
C
C LOGICAL variable ESTDIV
C
      LOGICAL ESTDIV
C
C Initialize IUFCLL
C
      IUFCLL=0
C
C Validate input data
C
C   Length of X-intervals
C
      DO 10 I=1,NX
         IF (X(I) .LE. X(I-1)) THEN
            IERR=1
            RETURN
         ENDIF
10    CONTINUE
C
C   Length of Y-intervals
C
      DO 20 I=1,NY
         IF (Y(I) .LE. Y(I-1)) THEN
            IERR=2
            RETURN
         ENDIF
20    CONTINUE
C
C   Check number of method
C
      IF (METHOD .LT. 0 .OR. METHOD .GT. 7) THEN
         IERR=3
         RETURN
C
C   Check number of sub-intervals
C
      ELSEIF (NX .LE. 0 .OR. NY .LE. 0) THEN
         IERR=4
         RETURN
      ELSE
         IERR=0
      ENDIF
C
C If necessary, check initial values
C
      IF (METHOD .NE. MOLD) THEN
        CALL K4GINI(METHOD,WORK)
        MOLD=METHOD
      ENDIF
C
C
      IF (ESTDIV) THEN
        KMAX=2
      ELSE
        KMAX=1
      ENDIF
C
C Loop over necessary cubature runs
C
      DO 30 K=1,KMAX
C
C Change K
C
         DBLEK=DBLE(K)
C
C Initialize CREC
C
         CREC=0.0D0
C
C Find approximation for the integral
C
         DO 40 I=0,NX-1
C
C Find step size in X-direction
C
            HX=(X(I+1)-X(I))/(2.0D0*DBLEK)
            DO 50 I1=1,2*K-1,2
               HXM=X(I)+DBLE(I1)*HX
               DO 60 J=0,NY-1
C
C Find step size in Y-direction
C
                  HY=(Y(I+1)-Y(I))/(2.0D0*DBLEK)
                  DO 70 J1=1,2*K-1,2
                     HYM=Y(J)+DBLE(J1)*HY
                     DO 80 II=0,METHOD
                        DO 90 JJ=0,METHOD
                           FAC=HX*HY*WORK(2,II)*WORK(2,JJ)
                           HELPF=USERF(HXM+HX*WORK(1,II),
     F                                 HYM+HY*WORK(1,JJ))
                           IUFCLL=IUFCLL+1
                           CREC=CREC+FAC*HELPF
90                      CONTINUE
80                   CONTINUE
70                CONTINUE
60             CONTINUE
50          CONTINUE
40       CONTINUE
C
C When estimating the error, store first integral value
C
         IF (ESTDIV .AND. K .EQ. 1) CRECH=CREC
30    CONTINUE
C
C Error estimation
C
      IF (ESTDIV) DIVIAT=(CREC-CRECH)/3.0D0
C
C Return to calling program
C
      RETURN
      END


Begin of file
Contents
Index