Télécharger la plaquette Cast3M


fr en

Télécharger kdom6.eso

Retour à la liste

Numérotation des lignes : 

kdom6

  1. C KDOM6     SOURCE    KK2000    14/04/10    21:15:13     8032
  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
  10. C DESCRIPTION       :  Subroutine called by LEKMA0
  11. C                      Given a QUA5 (IP1,IP2,IP3,IP4,IP5), IP5 is the center
  12. C                      points, this subroutine compute its volume by
  13. C                      dividing it into 4 rectangles
  14. C
  15. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  18. C
  19. C************************************************************************
  20. C
  21.  
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25.       INTEGER IP1,IP2,IP3, IP4, IP5, I1, IPCEL(4)
  26.       REAL*8 VOL, CELL, DX0,DY0,DZ0,DX1,DY1,DZ1
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMCOORD
  31. C
  32.       IPCEL(1)=IP1
  33.       IPCEL(2)=IP2
  34.       IPCEL(3)=IP3
  35.       IPCEL(4)=IP4
  36. C
  37.       VOL=0.0D0
  38. C
  39.       DZ0=0.0D0
  40.       DZ1=0.0D0
  41.       DX1=XCOOR((IPCEL(4)-1)*(IDIM+1)+1)-
  42.      &     XCOOR((IP5-1)*(IDIM+1)+1)
  43.       DY1=XCOOR((IPCEL(4)-1)*(IDIM+1)+2)-
  44.      &     XCOOR((IP5-1)*(IDIM+1)+2)
  45.       IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(4)-1)*(IDIM+1)+3)-
  46.      &     XCOOR((IP5-1)*(IDIM+1)+3)
  47.       DO I1=1,4
  48.          DX0=DX1
  49.          DY0=DY1
  50.          DZ0=DZ1
  51.          DX1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+1)-
  52.      &        XCOOR((IP5-1)*(IDIM+1)+1)
  53.          DY1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+2)-
  54.      &        XCOOR((IP5-1)*(IDIM+1)+2)
  55.          IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+3)-
  56.      &        XCOOR((IP5-1)*(IDIM+1)+3)
  57.          CELL=((DX0*DY1-DX1*DY0)**2)+
  58.      &        ((DY0*DZ1-DY1*DZ0)**2)+
  59.      &        ((DZ0*DX1-DZ1*DX0)**2)
  60.          VOl=VOL+(CELL**0.5D0)
  61.       ENDDO
  62.       VOL=VOL/2.0D0
  63.       RETURN
  64.       END
  65.  
  66.  
  67.  
  68.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales