C CALHPR    SOURCE    CHAT      05/01/12    21:46:12     5004
      SUBROUTINE CALHPR(X,Y,Z,PG,NPG)
      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
C***********************************************************************
C VERSION    : ????
C HISTORIQUE : 20/12/99: gounand
C    Modification du placement des points de Gauss (cas NPG=6)
C    sur le triangle de base du prisme (avant, ils étaient sur les
C    faces)
C
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C
C************************************************************************
      DIMENSION PG(NPG)
      REAL*8 X(NPG),Y(NPG),Z(NPG),U(5),H(5)
C     DATA R2/1.414213562/
C***
      R2=SQRT(2.D0)



      IF(NPG.EQ.1.OR.NPG.EQ.2)THEN
C
      NG=NPG
      X(1)=1.D0/3.D0*R2
      Y(1)=1.D0/3.D0*R2
      X(2)=1.D0/3.D0*R2
      Y(2)=1.D0/3.D0*R2
      GO TO 30
      ENDIF
C
      IF(NPG.EQ.6)THEN
      NG=2
      X(1)=R2/6.D0
      Y(1)=R2/6.D0
      X(2)=2.D0*R2/3.D0
      Y(2)=R2/6.D0
      X(3)=R2/6.D0
      Y(3)=2.D0*R2/3.D0
      X(4)=X(1)
      Y(4)=Y(1)
      X(5)=X(2)
      Y(5)=Y(2)
      X(6)=X(3)
      Y(6)=Y(3)
      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)
      A=0.D0
      B=1.D0
      CALL CALG1(A,B,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)/3.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