Esope source files

   1 : C KDOM6     SOURCE    CHAT      05/01/13    00:54:28     5004           
   2 :       SUBROUTINE KDOM6(IP1,IP2,IP3,IP4,IP5,VOL)
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM6
   9 : C                      
   9 : C DESCRIPTION       :  Subroutine called by LEKMA0
  10 : C                      Given a QUA5 (IP1,IP2,IP3,IP4,IP5), IP5 is the center
  11 : C                      points, this subroutine compute its volume by
  12 : C                      dividing it into 4 rectangles
  13 : C                      
  14 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15 : C      
  16 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF                        
  17 : C
  18 : C************************************************************************
  19 : C
  20 : C
  21 : C**** Variables de COOPTIO
  22 : C
  23 :       IMPLICIT INTEGER(I-N)
  24 :       INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  25 :      &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  26 :      &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  27 :      &     ,IECHO,   IIMPI,  IOSPI
  28 :      &     ,IDIM,    IFICLE, IPREFI     
  29 : C     &     ,MCOORD
  30 :      &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  31 :      &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  32 :      &     ,NORINC,NORVAL,NORIND,NORVAD
  33 :      &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  34 : C
  35 :       INTEGER IP1,IP2,IP3, IP4, IP5, I1, IPCEL(4)
  36 :       REAL*8 VOL, CELL, DX0,DY0,DZ0,DX1,DY1,DZ1
  37 : -INC CCOPTIO
  38 : -INC SMCOORD
  39 : C
  40 :       IPCEL(1)=IP1
  41 :       IPCEL(2)=IP2
  42 :       IPCEL(3)=IP3
  43 :       IPCEL(4)=IP4
  44 : C
  45 :       VOL=0.0D0
  46 : C
  47 :       DZ0=0.0D0
  48 :       DZ1=0.0D0
  49 :       DX1=XCOOR((IPCEL(4)-1)*(IDIM+1)+1)-
  50 :      &     XCOOR((IP5-1)*(IDIM+1)+1)
  51 :       DY1=XCOOR((IPCEL(4)-1)*(IDIM+1)+2)-
  52 :      &     XCOOR((IP5-1)*(IDIM+1)+2)
  53 :       IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(4)-1)*(IDIM+1)+3)-
  54 :      &     XCOOR((IP5-1)*(IDIM+1)+3)
  55 :       DO I1=1,4
  56 :          DX0=DX1
  57 :          DY0=DY1
  58 :          DZ0=DZ1
  59 :          DX1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+1)-
  60 :      &        XCOOR((IP5-1)*(IDIM+1)+1)
  61 :          DY1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+2)-
  62 :      &        XCOOR((IP5-1)*(IDIM+1)+2)
  63 :          IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+3)-
  64 :      &        XCOOR((IP5-1)*(IDIM+1)+3)
  65 :          CELL=((DX0*DY1-DX1*DY0)**2)+
  66 :      &        ((DY0*DZ1-DY1*DZ0)**2)+
  67 :      &        ((DZ0*DX1-DZ1*DX0)**2)
  68 :          VOl=VOL+(CELL**0.5D0)
  69 :       ENDDO
  70 :       VOL=VOL/2.0D0
  71 :       RETURN
  72 :       END
  73 :  
  74 :