Télécharger kbrese.eso

Retour à la liste

Numérotation des lignes :

kbrese
  1. C KBRESE SOURCE CHAT 06/03/29 21:23:37 5360
  2. SUBROUTINE KBRESE(K1,K2,NCEL,ICEL,KG) KPR02890
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C Calcul des facteurs de forme en 3D
  6. C Sp appele par KPARC KPR02900
  7. C KPR02900
  8. C Detarmination des cellules interceptées par la droite
  9. C reliant 2 cellules. Algorithme de Bresenham
  10. C NCEL : NOMBRE DE CELLULES APPROCHANT LE SEGMENT (K1,K2) KPR02910
  11. C ICEL : COORDONNEES CORRESPONDANTES KPR02920
  12. C KPR02930
  13. C KPR02940
  14. DIMENSION K1(2),K2(2),ICEL(2,1),KG(2) KPR02950
  15. I1 = K1(1) KPR02960
  16. J1 = K1(2) KPR02970
  17. I2 = K2(1) KPR02980
  18. J2 = K2(2) KPR02990
  19. C KPR03000
  20. NDI=IABS(I2-I1) KPR03010
  21. NDJ=IABS(J2-J1) KPR03020
  22. IF (NDI.EQ.0) THEN KPR03030
  23. IF(NDJ.EQ.0) THEN KPR03040
  24. NCEL = 1 KPR03050
  25. ICEL(1,1) = I1 KPR03060
  26. ICEL(2,1) = J1 KPR03070
  27. ELSE KPR03080
  28. NCEL = NDJ+1 KPR03090
  29. JA = MIN0(J1,J2) KPR03100
  30. DO 1 J=1,NCEL KPR03110
  31. ICEL(1,J) = I1 KPR03120
  32. ICEL(2,J) = JA+J-1 KPR03130
  33. 1 CONTINUE KPR03140
  34. ENDIF KPR03150
  35. ELSE KPR03160
  36. IF(NDJ.EQ.0) THEN KPR03170
  37. NCEL = NDI+1 KPR03180
  38. IA = MIN0(I1,I2) KPR03190
  39. DO 2 I=1,NCEL KPR03200
  40. ICEL(1,I) = IA + I - 1 KPR03210
  41. ICEL(2,I) = J1 KPR03220
  42. 2 CONTINUE KPR03230
  43. ELSE KPR03240
  44. C KPR03250
  45. IF (I1.GT.I2) THEN KPR03260
  46. IA=I2 KPR03270
  47. JA=J2 KPR03280
  48. IB=I1 KPR03290
  49. JB=J1 KPR03300
  50. ELSE KPR03310
  51. IA=I1 KPR03320
  52. JA=J1 KPR03330
  53. IB=I2 KPR03340
  54. JB=J2 KPR03350
  55. ENDIF KPR03360
  56. C KPR03370
  57. C CAS GENERAL KPR03380
  58. C KPR03390
  59. IF(JB.GT.JA) THEN KPR03470
  60. I= IA KPR03480
  61. J= JA KPR03490
  62. iarr=0 KPR03500
  63. NCEL = 0 KPR03510
  64. 10 CONTINUE KPR03520
  65. NCEL = NCEL + 1 KPR03530
  66. ICEL(1,NCEL) = I KPR03540
  67. ICEL(2,NCEL) = J KPR03550
  68. IF(I.NE.IB.OR.J.NE.JB) THEN KPR03560
  69. IF (iarr.GT.0) THEN KPR03570
  70. J = J + 1 KPR03580
  71. iarr = iarr - NDI KPR03590
  72. ELSE KPR03600
  73. IF (iarr.EQ.0) THEN KPR03610
  74. I = I + 1 KPR03690
  75. J = J + 1 KPR03700
  76. iarr = NDJ - NDI KPR03710
  77. ELSE KPR03720
  78. C iarr.LT.0 KPR03730
  79. I = I + 1 KPR03740
  80. iarr = iarr + NDJ KPR03750
  81. ENDIF KPR03760
  82. ENDIF KPR03770
  83. GOTO 10 KPR03780
  84. ENDIF KPR03790
  85. C PENTE INVERSE KPR03800
  86. ELSE KPR03810
  87. I= IA KPR03820
  88. J= JA KPR03830
  89. iarr=0 KPR03840
  90. NCEL = 0 KPR03850
  91. 11 CONTINUE KPR03860
  92. NCEL = NCEL + 1 KPR03870
  93. ICEL(1,NCEL) = I KPR03880
  94. ICEL(2,NCEL) = J KPR03890
  95. IF(I.NE.IB.OR.J.NE.JB) THEN KPR03900
  96. IF (iarr.LT.0) THEN KPR03910
  97. J = J - 1 KPR03920
  98. iarr = iarr + NDI KPR03930
  99. ELSE KPR03940
  100. IF (iarr.EQ.0) THEN KPR03950
  101. I = I + 1 KPR04030
  102. J = J - 1 KPR04040
  103. iarr = NDI - NDJ KPR04050
  104. ELSE KPR04060
  105. C iarr.GT.0 KPR04070
  106. I = I + 1 KPR04080
  107. iarr = iarr - NDJ KPR04090
  108. ENDIF KPR04100
  109. ENDIF KPR04110
  110. GOTO 11 KPR04120
  111. ENDIF KPR04130
  112. ENDIF KPR04140
  113. ENDIF KPR04150
  114. ENDIF KPR04160
  115. IF (NCEL.EQ.1) THEN KPR04170
  116. KG(1) = K1(1) KPR04180
  117. KG(2) = K1(2) KPR04190
  118. ELSE KPR04200
  119. C KPR04220
  120. KG(1)= (K1(1) + K2(1))/2 KPR04230
  121. KG(2)= (K1(2) + K2(2))/2 KPR04240
  122. C KPR04250
  123. ENDIF KPR04290
  124. RETURN KPR04300
  125. END KPR04310
  126.  
  127.  
  128.  
  129.  

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