Télécharger chahut.eso

Retour à la liste

Numérotation des lignes :

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

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