C KHPRM     SOURCE    CHAT      05/01/13    00:56:27     5004
      SUBROUTINE KHPRM(X,Y,Z,PG,NPG,X1,Y1,X2,Y2,Z1,Z2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C     CE SOUS PROGRAMME CALCULE LES POINTS D'INTEGRATION POUR UN
C     PRISME MACRO
C
C   |X1  o
C   |Y2  |\
C        | \
C        |  \
C        |   \
C        |    \
C        |     \
C |X1    |      \   |(X1+X2)/2
C |Y1+Y2 x       x  |(Y1+Y2)/2
C |----- |        \
C |  2   |         \
C        |          \
C        |      cas 3 pts d'integrations sur le triangle
C        |            \
C        |             \
C        |              \
C  |X1   o_______x_______o   |X2
C  |Y1                       |Y1
C               |(X1+X2)/2
C               |Y1
C
C
C
C
C
C************************************************************************
      DIMENSION PG(NPG)
      REAL*8 X(NPG),Y(NPG),Z(NPG),U(5),H(5)
C***


      IF(NPG.EQ.2)THEN
C
      NG=1
      X(1)=1.D0/3.D0*(X2-X1)
      Y(1)=1.D0/3.D0*(Y2-Y1)
      X(2)=X(1)
      Y(2)=Y(1)
      GO TO 30
      ENDIF
C
      IF(NPG.EQ.6)THEN
      NG=2
      X(1)=X1
      Y(1)=(Y1+Y2)/2.D0
      X(3)=(X1+X2)/2.D0
      Y(3)=Y1
      X(5)=(X1+X2)/2.D0
      Y(5)=(Y1+Y2)/2.D0
      X(2)=X(1)
      Y(2)=Y(1)
      X(4)=X(3)
      Y(4)=Y(3)
      X(6)=X(5)
      Y(6)=Y(5)
      GO TO 30
      ENDIF

      WRITE(6,*)' SUB CALHPR : NPG=',NPG
      WRITE(6,*)' NOMBRE DE POINTS D''INTEGRATION INCORECTE POUR UN ',
     & 'PRISME'
      CALL ARRET(0)

 30   CONTINUE
C
      CALL CALUHG(U,H,NG)
      CALL CALG1(Z1,Z2,NG,H,U,Z,PG)
      IF(NPG.NE.6) RETURN
      PG(3)=PG(1)
      PG(4)=PG(2)
      PG(5)=PG(1)
      PG(6)=PG(2)
      Z(3)=Z(1)
      Z(4)=Z(2)
      Z(5)=Z(1)
      Z(6)=Z(2)
      DO 21 L=1,NPG
      PG(L)=PG(L)/12.D0
 21   CONTINUE
C     SPG=0
C     DO 22 L=1,NPG
C     SPG=SPG+PG(L)
C22   CONTINUE
C     WRITE(6,1002)SPG
C     WRITE(6,1002)H
C     WRITE(6,1002)U
C     WRITE(6,1002)Z
C1002 FORMAT(10(1X,1PD11.4))
      RETURN
      END