Télécharger chahut.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAHUT SOURCE CHAT 05/01/12 21:54:17 5004
  2. SUBROUTINE CHAHUT(MELEME,ALFA)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC CCOPTIO
  6. -INC SMCOORD
  7. -INC SMELEME
  8. -INC SMLENTI
  9.  
  10. COEF=ALFA*0.05D0
  11. IF(IDIM.EQ.3)THEN
  12. WRITE(6,*)' DOMA : CHAHUT non prevu en 3D'
  13. RETURN
  14. ENDIF
  15.  
  16. JG=XCOOR(/1)/(IDIM+1)
  17. SEGINI MLENTI
  18. SEGACT MELEME
  19. NBSOUS=LISOUS(/1)
  20. IF(NBSOUS.EQ.0)NBSOUS=1
  21.  
  22. DO 1 L=1,NBSOUS
  23. IPT1=MELEME
  24. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  25. SEGACT IPT1
  26. NBEL=IPT1.NUM(/2)
  27. NP =IPT1.NUM(/1)
  28. DO 101 K=1,NBEL
  29. DO 102 I=2,NP,2
  30. N2=IPT1.NUM(I,K)
  31. LECT(N2)=LECT(N2)+1
  32. 102 CONTINUE
  33. 101 CONTINUE
  34. 1 CONTINUE
  35.  
  36. DO 2 L=1,NBSOUS
  37. IPT1=MELEME
  38. IF(NBSOUS.NE.1)IPT1=LISOUS(L)
  39. NBEL=NUM(/2)
  40. NP =NUM(/1)
  41.  
  42. IF(NP.EQ.6)THEN
  43. DO 206 K=1,NBEL
  44. N1=IPT1.NUM(1,K)
  45. N2=IPT1.NUM(2,K)
  46. N3=IPT1.NUM(3,K)
  47. N4=IPT1.NUM(3,K)
  48. N5=IPT1.NUM(3,K)
  49. N6=IPT1.NUM(3,K)
  50.  
  51.  
  52. XN1=XCOOR((N1-1)*(IDIM+1) +1)
  53. YN1=XCOOR((N1-1)*(IDIM+1) +2)
  54. XN2=XCOOR((N2-1)*(IDIM+1) +1)
  55. YN2=XCOOR((N2-1)*(IDIM+1) +2)
  56. XN3=XCOOR((N3-1)*(IDIM+1) +1)
  57. YN3=XCOOR((N3-1)*(IDIM+1) +2)
  58. XN4=XCOOR((N4-1)*(IDIM+1) +1)
  59. YN4=XCOOR((N4-1)*(IDIM+1) +2)
  60. XN5=XCOOR((N5-1)*(IDIM+1) +1)
  61. YN5=XCOOR((N5-1)*(IDIM+1) +2)
  62. XN6=XCOOR((N6-1)*(IDIM+1) +1)
  63. YN6=XCOOR((N6-1)*(IDIM+1) +2)
  64.  
  65. D1=(XN2-XN6)*(XN2-XN6)+(YN2-YN6)*(YN2-YN6)
  66. D1=SQRT(D1)
  67. D2=(XN2-XN4)*(XN2-XN4)+(YN2-YN4)*(YN2-YN4)
  68. D2=SQRT(D2)
  69. D3=(XN6-XN4)*(XN6-XN4)+(YN6-YN4)*(YN6-YN4)
  70. D3=SQRT(D2)
  71.  
  72. IF(LECT(N2).EQ.2)THEN
  73. D=MIN(D1,D2)*COEF
  74. UU=(XN2-XN5)*(XN2-XN5)+(YN2-YN5)*(YN2-YN5)
  75. UU=SQRT(UU)
  76. UX=(XN2-XN5)/UU
  77. UY=(YN2-YN5)/UU
  78. XCOOR((N2-1)*(IDIM+1) +1)= XCOOR((N2-1)*(IDIM+1) +1)+D*UX
  79. XCOOR((N2-1)*(IDIM+1) +2)= XCOOR((N2-1)*(IDIM+1) +2)+D*UY
  80. ENDIF
  81.  
  82. IF(LECT(N4).EQ.2)THEN
  83. D=MIN(D3,D2)*COEF
  84. UU=(XN1-XN4)*(XN1-XN4)+(YN1-YN4)*(YN1-YN4)
  85. UU=SQRT(UU)
  86. UX=(XN1-XN4)/UU
  87. UY=(YN1-YN4)/UU
  88. XCOOR((N4-1)*(IDIM+1) +1)= XCOOR((N4-1)*(IDIM+1) +1)+D*UX
  89. XCOOR((N4-1)*(IDIM+1) +2)= XCOOR((N4-1)*(IDIM+1) +2)+D*UY
  90. ENDIF
  91.  
  92. IF(LECT(N6).EQ.2)THEN
  93. D=MIN(D3,D1)*COEF
  94. UU=(XN6-XN3)*(XN6-XN3)+(YN6-YN3)*(YN6-YN3)
  95. UU=SQRT(UU)
  96. UX=(XN6-XN3)/UU
  97. UY=(YN6-YN3)/UU
  98. XCOOR((N6-1)*(IDIM+1) +1)= XCOOR((N6-1)*(IDIM+1) +1)+D*UX
  99. XCOOR((N6-1)*(IDIM+1) +2)= XCOOR((N6-1)*(IDIM+1) +2)+D*UY
  100. ENDIF
  101.  
  102.  
  103. 206 CONTINUE
  104. ELSEIF(NP.EQ.8)THEN
  105. GO TO 2
  106. ELSE
  107. WRITE(6,*)' DOMA : CHAHUT non prevu pour NP=',NP
  108. GO TO 2
  109. ENDIF
  110. SEGDES IPT1
  111. 2 CONTINUE
  112.  
  113. SEGDES MELEME
  114. SEGSUP MLENTI
  115.  
  116. RETURN
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  

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