C CALHRH    SOURCE    CHAT      05/01/12    21:46:15     5004
      SUBROUTINE CALHRH(AH,Q1,Q2,Q3,IES)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*****************************************************************************
C     CE SP CALCUL LES CORRECTIONS D'HOURGLASS EN 2D POUR UN QUA4
C                                              EN 3D POUR UN CUB8
C
C*****************************************************************************

-INC PPARAM
-INC CCOPTIO
      REAL*8 AH(8,8),V(4)
      REAL*8 A1(8,8),A2(8,8),A3(8,8),A4(8,8)
      REAL*8 Q1(8,8),Q2(8,8),Q3(8,8)
      REAL*8 V1(8),V2(8),V3(8),V4(8)

      DATA V4/-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0,1.D0,-1.D0/
      DATA V1/1.D0,1.D0,-1.D0,-1.D0,-1.D0,-1.D0,1.D0,1.D0/
      DATA V2/1.D0,-1.D0,-1.D0,1.D0,-1.D0,1.D0,1.D0,-1.D0/
      DATA V3/1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0,1.D0,-1.D0/
      DATA V/1.D0,-1.D0,1.D0,-1.D0/
C
C
C     WRITE(IOIMP,*)'CALHRH ies=',ies
      IF(IES.EQ.2)THEN
         NP=4
         DO 1 I=1,NP
            DO 11 J=1,NP
               AH(J,I)=V(I)*V(J)
 11         CONTINUE
 1       CONTINUE
         RETURN
C
      ELSEIF(IES.EQ.3)THEN
         NP=8
         DO 2 I=1,NP
            DO 21 J=1,NP
               A1(J,I)=V1(I)*V1(J)
 21         CONTINUE
 2       CONTINUE
C     WRITE(IOIMP,1008)A1
         DO 3 I=1,NP
            DO 31 J=1,NP
               A2(J,I)=V2(I)*V2(J)
 31         CONTINUE
 3       CONTINUE
C     WRITE(IOIMP,1008)A2
         DO 4 I=1,NP
            DO 41 J=1,NP
               A3(J,I)=V3(I)*V3(J)
 41         CONTINUE
 4       CONTINUE
C     WRITE(IOIMP,1008)A3
         DO 5 I=1,NP
            DO 51 J=1,NP
               A4(J,I)=V4(I)*V4(J)
 51         CONTINUE
 5       CONTINUE
C     WRITE(IOIMP,1008)A4
 1004    FORMAT(4(10X,1PE11.4,2X,1PE11.4,2X,1PE11.4,2X,1PE11.4/))
         DO 10 I=1,NP
            DO 101 J=1,NP
               Q1(J,I)=(A1(J,I)+A2(J,I)+A4(J,I)/3.D0)/48.D0
               Q2(J,I)=(A1(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0
               Q3(J,I)=(A2(J,I)+A3(J,I)+A4(J,I)/3.D0)/48.D0
               AH(J,I)=Q1(J,I)+Q2(J,I)+Q3(J,I)
 101        CONTINUE
 10      CONTINUE
C     WRITE(IOIMP,1008)AH
         RETURN
      ELSE
         WRITE(IOIMP,*)' DIMENSION ESPACE ERRONEE '
         CALL ARRET(0)
      ENDIF
 1008 FORMAT(/8(1X,1PE11.4))
      END