End of file
Contents
Index



F 16.7 Gauß Cubature Formulas for Triangles


      SUBROUTINE K3GAUN(USERF,PX,PY,QX,QY,RX,RY,N,METHOD,MOLD,
     +                  CTRI,WORK,IERR,IUFCLL)
C
C*****************************************************************
C                                                                *
C Gaussian cubature over triangular regions:                     *
C                                                                *
C The FUNCTION USERF(X,Y) is integrated over the triangle PQR    *
C according to the summed N point gaussian formula using N*N     *
C sub-triangles.                                                 *
C The dimensions of these sub-triangles are one Nth of those of  *
C the original triangle PQR.                                     *
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 PX      : DOUBLE PRECISION X-coordinate of the vertex P        *
C PY      : DOUBLE PRECISION Y-coordinate of the vertex P        *
C QX      : DOUBLE PRECISION X-coordinate of the vertex Q        *
C QY      : DOUBLE PRECISION Y-coordinate of the vertex Q        *
C RX      : DOUBLE PRECISION X-coordinate of the vertex R        *
C RY      : DOUBLE PRECISION Y-coordinate of the vertex R        *
C N       : INTEGER, counting the number of sub-triangles formed *
C           along one edge of the triangle.                      *
C METHOD  : INTEGER, designating the method: If METHOD=1,2,3 or 7*
C           the 1, 2, 3 or 7 point Gauss formula is chosen.      *
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 K3GAUN is called repeatedly with METHOD=MOLD the  *
C           internal initializing of parameters is skipped.      *
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 the number of points used in the  *
C           Gauss method.                                        *
C CTRI    : DOUBLE PRECISION approximate value for the integral  *
C WORK    : 2-dimensional DOUBLE PRECISION array                 *
C           WORK(3,0:METHOD-1) containing the constants needed   *
C           for the specified method                             *
C IERR    : error parameter: IERR=0 all is ok                    *
C                            IERR=1 N is incorrect               *
C                            IERR=2 the vertices P Q and R are   *
C                                   collinear                    *
C                            IERR=3 invalid Number for the method*
C IUFCLL  : INTEGER, the number of function evaluations performed*
C                                                                *
C                                                                *
C INTERMEDIATE VARIABLES:                                        *
C =======================                                        *
C I,J     : loop variables                                       *
C II,JJ   : loop variables                                       *
C DBLEN   : DOUBLE PRECISION version of N                        *
C DBLEI   : DOUBLE PRECISION version of I                        *
C DBLEJ   : DOUBLE PRECISION version of J                        *
C AREA    : DOUBLE PRECISION to check collinearity               *
C EPS     : DOUBLE PRECISION bound for collinearity check        *
C HPQX    : DOUBLE PRECISION ]   vectoriel representation of     *
C HPQY    : DOUBLE PRECISION ]   the steps taken along the edge  *
C HPRX    : DOUBLE PRECISION ]   PQ or PR, respectively          *
C HPRY    : DOUBLE PRECISION ]                                   *
C FAC     : DOUBLE PRECISION number, indicates type of triangle  *
C                              FAC=1.0  (not symmetric) or       *
C                              FAC=-1.0 (reflection symmetric)   *
C X       : DOUBLE PRECISION ]   coordinates of the top vertex   *
C Y       : DOUBLE PRECISION ]   of the sub-triangle in use.     *
C                                                                *
C XX      : DOUBLE PRECISION ]   These are auxiliary variables   *
C YY      : DOUBLE PRECISION ]   that determine the weights.     *
C                                                                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: K3GINI                                  *
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(3,0:METHOD-1),
     +                 PX,PY,QX,QY,RX,RY,CTRI,AREA,EPS,HPQX,HPQY,
     +                 HPRX,HPRY,FAC,DBLEN,DBLEJ,DBLEI,X,XX,Y,YY,
     +                 USERF
C
C initialize bound for collinearity check
C
      EPS=1.0D-06
C
C check N
C
      IF (N .LT. 1) THEN
         IERR=1
         RETURN
      ENDIF
C
C   test for collinearity
C
      AREA=PX*QY+QX*RY+RX*PY-PX*RY-QX*PY-RX*QY
      IF (AREA .LT. EPS) THEN
         IERR=2
         RETURN
C
C   check validity of method number
C
      ELSEIF (METHOD .LT. 0 .OR.  METHOD .GT. 7 .OR.
     +        METHOD .GT. 3 .AND. METHOD .LT. 7) THEN
         IERR=3
         RETURN
      ELSE
         IERR=0
      ENDIF
C
C Initialize if necessary
C
      IF (METHOD .NE. MOLD) THEN
        CALL K3GINI(METHOD,WORK)
        MOLD=METHOD
      ENDIF
C
C Initialize IUFCLL
C
      IUFCLL=0
C
C find twice the area
C
      DBLEN=DBLE(N)
      AREA=AREA/(DBLEN*DBLEN)
C
C vektorize the step size
C
      HPQX=(QX-PX)/DBLEN
      HPQY=(QY-PY)/DBLEN
      HPRX=(RX-PX)/DBLEN
      HPRY=(RY-PY)/DBLEN
\hbox{\JDhspace\verb`
C
C Initialize CTRI
C
         CTRI=0.0D0
C
C Approximate the integral
C
         DO 10 JJ=0,1
C
C   triangle reflection symmetric or not
C
            IF (JJ .EQ. 0) THEN
               FAC=1.0D0
            ELSE
               FAC=-1.0D0
            ENDIF
C
C   loop along the edge PR
C
            DO 20 J=JJ,N-1
               DBLEJ=DBLE(J)
C
C   loop along the edge PQ
C
               DO 30 I=JJ,N-1-J+JJ
                  DBLEI=DBLE(I)
C
C   find the coordinates of the top vertex of the sub-triangle
C
                  X=PX+HPQX*DBLEI+HPRX*DBLEJ
                  Y=PY+HPQY*DBLEI+HPRY*DBLEJ
C
C   sum the weighted functional values
C
                  DO 40 II=0,METHOD-1
                     XX=HPQX*WORK(2,II)+HPRX*WORK(3,II)
                     YY=HPQY*WORK(2,II)+HPRY*WORK(3,II)
                     CTRI=CTRI+WORK(1,II)*USERF(X+FAC*XX,Y+FAC*YY)
C
C   count number of functional evaluations
C
                     IUFCLL=IUFCLL+1
40                CONTINUE
30             CONTINUE
20          CONTINUE
10       CONTINUE
C
C Multiply by the area
C
         CTRI=CTRI*AREA
C
C return to calling program
C
      RETURN
      END
C
C

      SUBROUTINE K3GINI(METHOD,WORK)
C
C*****************************************************************
C                                                                *
C SUBROUTINE that initializes the constants in accordance with   *
C the method.                                                    *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C METHOD  : INTEGER designating the method: METHOD= 1,2,3 or 7.  *
C           This indicates the number of points used.            *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C WORK    : 2-dimensional DOUBLE PRECISION array                 *
C           WORK(3,0:METHOD-1) containing the constants for the  *
C           method used.                                         *
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(3,0:METHOD-1)
C
C  Initialize the array WORK depending on specified method
C
      IF (METHOD .EQ. 1) THEN
         WORK(1,0)= 0.5D0
         WORK(2,0)= 0.3333333333333333D0
         WORK(3,0)= 0.3333333333333333D0
      ELSEIF (METHOD .EQ. 2) THEN
         WORK(1,0)= 0.25D0
         WORK(2,0)= 0.1666666666666667D0
         WORK(3,0)= 0.5D0
         WORK(1,1)= 0.25D0
         WORK(2,1)= 0.5D0
         WORK(3,1)= 0.1666666666666667D0
      ELSEIF (METHOD .EQ. 3) THEN
         WORK(1,0)= 0.16666666666666667D0
         WORK(2,0)= 0.1666666666666667D0
         WORK(3,0)= 0.1666666666666667D0
         WORK(1,1)= 0.16666666666666667D0
         WORK(2,1)= 0.6666666666666667D0
         WORK(3,1)= 0.1666666666666667D0
         WORK(1,2)= 0.16666666666666667D0
         WORK(2,2)= 0.1666666666666667D0
         WORK(3,2)= 0.6666666666666667D0
      ELSEIF (METHOD .EQ. 7) THEN
         WORK(1,0)= 0.1125D0
         WORK(2,0)= 0.3333333333333333D0
         WORK(3,0)= 0.3333333333333333D0
         WORK(1,1)= 0.0661970763942531D0
         WORK(2,1)= 0.4701420641051151D0
         WORK(3,1)= 0.4701420641051151D0
         WORK(1,2)= 0.0661970763942531D0
         WORK(2,2)= 0.05971587178976981D0
         WORK(3,2)= 0.4701420641051151D0
         WORK(1,3)= 0.0661970763942531D0
         WORK(2,3)= 0.4701420641051151D0
         WORK(3,3)= 0.05971587178976981D0
         WORK(1,4)= 0.06296959027241357D0
         WORK(2,4)= 0.1012865073234563D0
         WORK(3,4)= 0.1012865073234563D0
         WORK(1,5)= 0.06296959027241357D0
         WORK(2,5)= 0.7974269853530873D0
         WORK(3,5)= 0.1012865073234563D0
         WORK(1,6)= 0.06296959027241357D0
         WORK(2,6)= 0.1012865073234563D0
         WORK(3,6)= 0.7974269853530873D0
      ENDIF
C
C Return to calling program
C
      RETURN
      END


Begin of file
Contents
Index