C KDOM6     SOURCE    KK2000    14/04/10    21:15:13     8032
      SUBROUTINE KDOM6(IP1,IP2,IP3,IP4,IP5,VOL)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KDOM6
C
C DESCRIPTION       :  Subroutine called by LEKMA0
C                      Given a QUA5 (IP1,IP2,IP3,IP4,IP5), IP5 is the center
C                      points, this subroutine compute its volume by
C                      dividing it into 4 rectangles
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C
C************************************************************************
C

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

      INTEGER IP1,IP2,IP3, IP4, IP5, I1, IPCEL(4)
      REAL*8 VOL, CELL, DX0,DY0,DZ0,DX1,DY1,DZ1

-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
C
      IPCEL(1)=IP1
      IPCEL(2)=IP2
      IPCEL(3)=IP3
      IPCEL(4)=IP4
C
      VOL=0.0D0
C
      DZ0=0.0D0
      DZ1=0.0D0
      DX1=XCOOR((IPCEL(4)-1)*(IDIM+1)+1)-
     &     XCOOR((IP5-1)*(IDIM+1)+1)
      DY1=XCOOR((IPCEL(4)-1)*(IDIM+1)+2)-
     &     XCOOR((IP5-1)*(IDIM+1)+2)
      IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(4)-1)*(IDIM+1)+3)-
     &     XCOOR((IP5-1)*(IDIM+1)+3)
      DO I1=1,4
         DX0=DX1
         DY0=DY1
         DZ0=DZ1
         DX1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+1)-
     &        XCOOR((IP5-1)*(IDIM+1)+1)
         DY1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+2)-
     &        XCOOR((IP5-1)*(IDIM+1)+2)
         IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+3)-
     &        XCOOR((IP5-1)*(IDIM+1)+3)
         CELL=((DX0*DY1-DX1*DY0)**2)+
     &        ((DY0*DZ1-DY1*DZ0)**2)+
     &        ((DZ0*DX1-DZ1*DX0)**2)
         VOl=VOL+(CELL**0.5D0)
      ENDDO
      VOL=VOL/2.0D0
      RETURN
      END