Télécharger kdom4.eso

Retour à la liste

Numérotation des lignes :

  1. C KDOM4 SOURCE KK2000 14/04/10 21:15:13 8032
  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
  10. C DESCRIPTION : Subroutine called by KDOM3
  11. C Given a tetrahedra with base (IP1,IP2,IP3,IP4)
  12. C this subroutine compute its volume and its mass
  13. C center.
  14. C N.B.: VOL is positive if and only if (IP1-IP3),
  15. C (IP2 - IP3), (IP4 - IP3) are "right-hand"
  16. C oriented vectors (positive mixed product)
  17. C
  18. C
  19. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  20. C
  21. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  22. C
  23. C************************************************************************
  24. C
  25. C
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. C
  29. INTEGER IP1,IP2,IP3,IP4, I1
  30. REAL*8 XCEN(3), VOL, DHX,DHY,DHZ,DAX,DAY,DAZ,DBX,DBY,DBZ
  31. -INC CCOPTIO
  32. -INC SMCOORD
  33. C
  34. DHX=XCOOR((IP4-1)*(IDIM+1)+1)-XCOOR((IP3-1)*(IDIM+1)+1)
  35. DHY=XCOOR((IP4-1)*(IDIM+1)+2)-XCOOR((IP3-1)*(IDIM+1)+2)
  36. DHZ=XCOOR((IP4-1)*(IDIM+1)+3)-XCOOR((IP3-1)*(IDIM+1)+3)
  37. C
  38. DAX=XCOOR((IP1-1)*(IDIM+1)+1)-XCOOR((IP3-1)*(IDIM+1)+1)
  39. DAY=XCOOR((IP1-1)*(IDIM+1)+2)-XCOOR((IP3-1)*(IDIM+1)+2)
  40. DAZ=XCOOR((IP1-1)*(IDIM+1)+3)-XCOOR((IP3-1)*(IDIM+1)+3)
  41. DBX=XCOOR((IP2-1)*(IDIM+1)+1)-XCOOR((IP3-1)*(IDIM+1)+1)
  42. DBY=XCOOR((IP2-1)*(IDIM+1)+2)-XCOOR((IP3-1)*(IDIM+1)+2)
  43. DBZ=XCOOR((IP2-1)*(IDIM+1)+3)-XCOOR((IP3-1)*(IDIM+1)+3)
  44. VOL=(DAX*DBY*DHZ+DAY*DBZ*DHX+DAZ*DBX*DHY-
  45. & (DAZ*DBY*DHX+DAX*DBZ*DHY+DAY*DBX*DHZ))/6.0D0
  46. DO I1=1,3,1
  47. XCEN(I1)=(XCOOR((IP4-1)*(IDIM+1)+I1)+
  48. & XCOOR((IP3-1)*(IDIM+1)+I1)+
  49. & XCOOR((IP1-1)*(IDIM+1)+I1)+
  50. & XCOOR((IP2-1)*(IDIM+1)+I1))/4.0D0
  51. ENDDO
  52. C
  53. RETURN
  54. C
  55. END
  56.  
  57.  
  58.  
  59.  

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