Esope source files

   1 : C KDOM4     SOURCE    CHAT      05/01/13    00:54:22     5004           
   2 :       SUBROUTINE KDOM4(IP1,IP2,IP3,IP4,XCEN,VOL)
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM4
   9 : C                      
   9 : C DESCRIPTION       :  Subroutine called by KDOM3
  10 : C                      Given a tetrahedra with base (IP1,IP2,IP3,IP4)
  11 : C                      this subroutine compute its volume and its mass
  12 : C                      center.
  13 : C                      N.B.: VOL is positive if and only if (IP1-IP3),
  14 : C                            (IP2 - IP3), (IP4 - IP3) are "right-hand"
  15 : C                            oriented vectors (positive mixed product)
  16 : C                            
  17 : C                      
  18 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19 : C      
  20 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF                        
  21 : C
  22 : C************************************************************************
  23 : C
  24 : C
  25 : C**** Variables de COOPTIO
  26 : C
  27 :       IMPLICIT INTEGER(I-N)
  28 :       INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  29 :      &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  30 :      &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  31 :      &     ,IECHO,   IIMPI,  IOSPI
  32 :      &     ,IDIM,    IFICLE, IPREFI     
  33 : C     &     ,MCOORD
  34 :      &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  35 :      &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  36 :      &     ,NORINC,NORVAL,NORIND,NORVAD
  37 :      &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  38 : C
  39 :       INTEGER IP1,IP2,IP3,IP4, I1
  40 :       REAL*8 XCEN(3), VOL, DHX,DHY,DHZ,DAX,DAY,DAZ,DBX,DBY,DBZ
  41 : -INC CCOPTIO
  42 : -INC SMCOORD
  43 : C
  44 :       DHX=XCOOR((IP4-1)*(IDIM+1)+1)-XCOOR((IP3-1)*(IDIM+1)+1)
  45 :       DHY=XCOOR((IP4-1)*(IDIM+1)+2)-XCOOR((IP3-1)*(IDIM+1)+2)
  46 :       DHZ=XCOOR((IP4-1)*(IDIM+1)+3)-XCOOR((IP3-1)*(IDIM+1)+3)
  47 : C
  48 :       DAX=XCOOR((IP1-1)*(IDIM+1)+1)-XCOOR((IP3-1)*(IDIM+1)+1)
  49 :       DAY=XCOOR((IP1-1)*(IDIM+1)+2)-XCOOR((IP3-1)*(IDIM+1)+2)
  50 :       DAZ=XCOOR((IP1-1)*(IDIM+1)+3)-XCOOR((IP3-1)*(IDIM+1)+3)
  51 :       DBX=XCOOR((IP2-1)*(IDIM+1)+1)-XCOOR((IP3-1)*(IDIM+1)+1)
  52 :       DBY=XCOOR((IP2-1)*(IDIM+1)+2)-XCOOR((IP3-1)*(IDIM+1)+2)
  53 :       DBZ=XCOOR((IP2-1)*(IDIM+1)+3)-XCOOR((IP3-1)*(IDIM+1)+3)
  54 :       VOL=(DAX*DBY*DHZ+DAY*DBZ*DHX+DAZ*DBX*DHY-
  55 :      &     (DAZ*DBY*DHX+DAX*DBZ*DHY+DAY*DBX*DHZ))/6.0D0
  56 :       DO I1=1,3,1
  57 :          XCEN(I1)=(XCOOR((IP4-1)*(IDIM+1)+I1)+
  58 :      &        XCOOR((IP3-1)*(IDIM+1)+I1)+
  59 :      &        XCOOR((IP1-1)*(IDIM+1)+I1)+
  60 :      &        XCOOR((IP2-1)*(IDIM+1)+I1))/4.0D0
  61 :       ENDDO
  62 : C
  63 :       RETURN
  64 : C     
  65 :       END
  66 :  
  67 :