Télécharger ksubdv.eso

Retour à la liste

Numérotation des lignes :

ksubdv
  1. C KSUBDV SOURCE CHAT 05/01/13 01:09:11 5004
  2. SUBROUTINE KSUBDV(A2,AA,NSUB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C
  6. C Calcul des facteurs de forme en 3D
  7. C Sp appele par KPROJF
  8. C Subdivision d'un triangle en 4 triangles
  9. C
  10. DIMENSION A1(3,3)
  11. DIMENSION A2(3,3),AA(3,3,4)
  12.  
  13. NSUB = 4
  14. C
  15. C SOMMETS
  16. C
  17. DO 10 K=1,3
  18. A1(K,1) = (A2(K,1)+A2(K,2))/2.
  19. A1(K,2) = (A2(K,2)+A2(K,3))/2.
  20. A1(K,3) = (A2(K,3)+A2(K,1))/2.
  21. 10 CONTINUE
  22. C
  23. C 4 ELEMENTS
  24. C
  25. DO 11 K =1,3
  26. AA(K,1,1) = A2(K,1)
  27. AA(K,2,1) = A1(K,1)
  28. AA(K,3,1) = A1(K,3)
  29. 11 CONTINUE
  30. C
  31. DO 12 K =1,3
  32. AA(K,1,2) = A2(K,2)
  33. AA(K,2,2) = A1(K,2)
  34. AA(K,3,2) = A1(K,1)
  35. 12 CONTINUE
  36.  
  37. DO 13 K =1,3
  38. AA(K,1,3) = A2(K,3)
  39. AA(K,2,3) = A1(K,3)
  40. AA(K,3,3) = A1(K,2)
  41. 13 CONTINUE
  42.  
  43. DO 14 K =1,3
  44. AA(K,1,4) = A1(K,1)
  45. AA(K,2,4) = A1(K,2)
  46. AA(K,3,4) = A1(K,3)
  47. 14 CONTINUE
  48.  
  49. RETURN
  50. END
  51.  
  52.  
  53.  

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