Télécharger ksclas.eso

Retour à la liste

Numérotation des lignes :

  1. C KSCLAS SOURCE CB215821 16/04/22 21:15:03 8922
  2. SUBROUTINE KSCLAS (A,D1,IES,NS)
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. C Calcul des facteurs de forme en 3D
  8. C Sp appele par KCREPA (decoupage des faces)
  9. C Dete
  10. C A : SOMMETS
  11. C D : LONGUEUR DES COTES
  12. C
  13. C
  14. DIMENSION A(IES,NS),D1(NS)
  15. DIMENSION B(3,3),D(3)
  16. DIMENSION KA(3),KD(3)
  17. C
  18. D(1)=0.D0
  19. DO 1 K = 1,NS
  20. D(1) = D(1) + (A(K,2)-A(K,1))*(A(K,2)-A(K,1))
  21. 1 CONTINUE
  22. D(1) = SQRT(D(1))
  23.  
  24. D(2)=0.D0
  25. DO 2 K = 1,NS
  26. D(2) = D(2) + (A(K,3)-A(K,2))*(A(K,3)-A(K,2))
  27. 2 CONTINUE
  28. D(2) = SQRT(D(2))
  29. C
  30. D(3) = 0.D0
  31. DO 3 K = 1,NS
  32. D(3) = D(3) + (A(K,1)-A(K,3))*(A(K,1)-A(K,3))
  33. 3 CONTINUE
  34. D(3) = SQRT(D(3))
  35.  
  36. C WRITE(6,*) ' D ',D(1),D(2),D(3)
  37. DO 10 I = 1,NS
  38. DO 11 K = 1,IES
  39. B(K,I)=A(K,I)
  40. 11 CONTINUE
  41. 10 CONTINUE
  42.  
  43. IF (D(1).LE.D(2)) THEN
  44. IF (D(2).LE.D(3)) THEN
  45. KD(1)=1
  46. KD(2)=2
  47. KD(3)=3
  48. KA(1)=1
  49. KA(2)=2
  50. KA(3)=3
  51. ELSE
  52. IF (D(1).LE.D(3)) THEN
  53. KD(1)=1
  54. KD(2)=3
  55. KD(3)=2
  56. KA(1)=2
  57. KA(2)=1
  58. KA(3)=3
  59. ELSE
  60. KD(1)=3
  61. KD(2)=1
  62. KD(3)=2
  63. KA(1)=3
  64. KA(2)=1
  65. KA(3)=2
  66. ENDIF
  67. ENDIF
  68. ELSE
  69. IF (D(1).LE.D(3)) THEN
  70. KD(1)=2
  71. KD(2)=1
  72. KD(3)=3
  73. KA(1)=3
  74. KA(2)=2
  75. KA(3)=1
  76. ELSE
  77. IF (D(2).LE.D(3)) THEN
  78. KD(1)=2
  79. KD(2)=3
  80. KD(3)=1
  81. KA(1)=2
  82. KA(2)=3
  83. KA(3)=1
  84. ELSE
  85. KD(1)=3
  86. KD(2)=2
  87. KD(3)=1
  88. KA(1)=1
  89. KA(2)=3
  90. KA(3)=2
  91. ENDIF
  92. ENDIF
  93. ENDIF
  94.  
  95. DO 20 I = 1,NS
  96. D1(I)=D(KD(I))
  97. DO 21 K = 1,IES
  98. A(K,I)=B(K,KA(I))
  99. 21 CONTINUE
  100. 20 CONTINUE
  101.  
  102. C WRITE(6,*) ' D1 ',D1(1),D1(2),D1(3)
  103.  
  104. RETURN
  105. END
  106.  
  107.  

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