Télécharger kdom6.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  28. -INC SMCOORD
  29. C
  30. IPCEL(1)=IP1
  31. IPCEL(2)=IP2
  32. IPCEL(3)=IP3
  33. IPCEL(4)=IP4
  34. C
  35. VOL=0.0D0
  36. C
  37. DZ0=0.0D0
  38. DZ1=0.0D0
  39. DX1=XCOOR((IPCEL(4)-1)*(IDIM+1)+1)-
  40. & XCOOR((IP5-1)*(IDIM+1)+1)
  41. DY1=XCOOR((IPCEL(4)-1)*(IDIM+1)+2)-
  42. & XCOOR((IP5-1)*(IDIM+1)+2)
  43. IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(4)-1)*(IDIM+1)+3)-
  44. & XCOOR((IP5-1)*(IDIM+1)+3)
  45. DO I1=1,4
  46. DX0=DX1
  47. DY0=DY1
  48. DZ0=DZ1
  49. DX1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+1)-
  50. & XCOOR((IP5-1)*(IDIM+1)+1)
  51. DY1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+2)-
  52. & XCOOR((IP5-1)*(IDIM+1)+2)
  53. IF(IDIM. EQ. 3) DZ1=XCOOR((IPCEL(I1)-1)*(IDIM+1)+3)-
  54. & XCOOR((IP5-1)*(IDIM+1)+3)
  55. CELL=((DX0*DY1-DX1*DY0)**2)+
  56. & ((DY0*DZ1-DY1*DZ0)**2)+
  57. & ((DZ0*DX1-DZ1*DX0)**2)
  58. VOl=VOL+(CELL**0.5D0)
  59. ENDDO
  60. VOL=VOL/2.0D0
  61. RETURN
  62. END
  63.  
  64.  
  65.  
  66.  

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