Esope source files

   1 : C KDOM3     SOURCE    CHAT      05/01/13    00:54:06     5004           
   2 :       SUBROUTINE KDOM3(IP1,IP2,IP3,IP4,IP5,IP6,XCEN,VOL)
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM3
   9 : C                      
   9 : C DESCRIPTION       :  Subroutine called by KDOM2
  10 : C                      Given a pyramid with base (IP1,IP2,IP3,IP4),
  11 : C                      IP5 = center of the base
  12 : C                      IP6 = vertex of the pyramid
  13 : C                      this subroutine compute the volume of the 4
  14 : C                      tetrahedra (IP1,IP2,IP5,IP6),(IP2,IP3,IP5,IP6),
  15 : C                                 (IP3,IP4,IP5,IP6),(IP4,IP1,IP5,IP6)
  16 : C                      and its mass center.
  17 : C                      VOL can be positive or negative depending on
  18 : C                      the orientation of the vectors
  19 : C                      (see KDOM4)
  20 : C                      
  21 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  22 : C      
  23 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF                        
  24 : C
  25 : C************************************************************************
  26 : C
  27 : C
  28 : C**** Variables de COOPTIO
  29 : C
  30 :       IMPLICIT INTEGER(I-N)
  31 :       INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  32 :      &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  33 :      &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  34 :      &     ,IECHO,   IIMPI,  IOSPI
  35 :      &     ,IDIM,    IFICLE, IPREFI     
  36 :      &     ,MCOORD
  37 :      &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  38 :      &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  39 :      &     ,NORINC,NORVAL,NORIND,NORVAD
  40 :      &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  41 : C
  42 :       INTEGER IP1,IP2,IP3,IP4,IP5,IP6, I1
  43 :       REAL*8 XCEN(3), VOL
  44 :      &     ,X1(3),X2(3),X3(3),X4(3),VOL1,VOL2,VOL3,VOL4
  45 : -INC CCOPTIO
  46 : C     (IP1,IP2,IP5,IP6)
  46 :       CALL KDOM4(IP1,IP2,IP5,IP6,X1,VOL1)
  47 : C     (IP2,IP3,IP5,IP6)
  47 :       CALL KDOM4(IP2,IP3,IP5,IP6,X2,VOL2)
  48 : C     (IP3,IP4,IP5,IP6)
  48 :       CALL KDOM4(IP3,IP4,IP5,IP6,X3,VOL3)
  49 : C     (IP4,IP1,IP5,IP6)          
  49 :       CALL KDOM4(IP4,IP1,IP5,IP6,X4,VOL4)
  50 : C     
  51 :       VOL=VOL1+VOL2+VOL3+VOL4
  52 :       DO I1=1,3,1
  53 :          XCEN(I1)=((VOL1*X1(I1))+(VOL2*X2(I1))+(VOL3*X3(I1))
  54 :      &        +(VOL4*X4(I1)))/VOL
  55 :       ENDDO
  56 : C
  57 :       RETURN
  58 : C     
  59 :       END
  60 :  
  61 :