Télécharger la plaquette Cast3M


fr en

Télécharger kbrese.eso

Retour à la liste

Numérotation des lignes : 

kbrese

  1. C KBRESE    SOURCE    CB215821  25/04/22    21:15:07     12245          
  2.       SUBROUTINE  KBRESE(K1,K2,NCEL,ICEL,KG)
  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
  7. C
  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)
  11. C     ICEL : COORDONNEES CORRESPONDANTES
  12. C
  13. C
  14.       DIMENSION K1(2),K2(2),ICEL(2,1),KG(2)
  15.       I1 = K1(1)
  16.       J1 = K1(2)
  17.       I2 = K2(1)
  18.       J2 = K2(2)
  19. C
  20.       NDI=IABS(I2-I1)
  21.       NDJ=IABS(J2-J1)
  22.       IF (NDI.EQ.0) THEN
  23.          IF(NDJ.EQ.0) THEN
  24.              NCEL = 1
  25.              ICEL(1,1) = I1
  26.              ICEL(2,1) = J1
  27.          ELSE
  28.              NCEL = NDJ+1
  29.              JA = MIN0(J1,J2)
  30.              DO 1 J=1,NCEL
  31.              ICEL(1,J) = I1
  32.              ICEL(2,J) = JA+J-1
  33.  1           CONTINUE
  34.          ENDIF
  35.       ELSE
  36.         IF(NDJ.EQ.0) THEN
  37.              NCEL = NDI+1
  38.              IA = MIN0(I1,I2)
  39.              DO 2 I=1,NCEL
  40.              ICEL(1,I) = IA + I - 1
  41.              ICEL(2,I) = J1
  42.   2          CONTINUE
  43.         ELSE
  44. C
  45.          IF (I1.GT.I2)   THEN
  46.              IA=I2
  47.              JA=J2
  48.              IB=I1
  49.              JB=J1
  50.          ELSE
  51.              IA=I1
  52.              JA=J1
  53.              IB=I2
  54.              JB=J2
  55.          ENDIF
  56. C
  57. C CAS GENERAL
  58. C
  59.          IF(JB.GT.JA) THEN
  60.           I= IA
  61.           J= JA
  62.           iarr=0
  63.           NCEL = 0
  64.   10      CONTINUE
  65.           NCEL = NCEL + 1
  66.           ICEL(1,NCEL) = I
  67.           ICEL(2,NCEL) = J
  68.           IF(I.NE.IB.OR.J.NE.JB) THEN
  69.              IF (iarr.GT.0)  THEN
  70.                J = J + 1
  71.                iarr = iarr - NDI
  72.              ELSE
  73.                  IF (iarr.EQ.0)  THEN
  74.                    I = I + 1
  75.                    J = J + 1
  76.                    iarr = NDJ - NDI
  77.                  ELSE
  78. C                iarr.LT.0
  79.                      I = I + 1
  80.                      iarr = iarr + NDJ
  81.                  ENDIF
  82.              ENDIF
  83.              GOTO 10
  84.           ENDIF
  85. C    PENTE INVERSE
  86.          ELSE
  87.           I= IA
  88.           J= JA
  89.           iarr=0
  90.           NCEL = 0
  91.   11      CONTINUE
  92.           NCEL = NCEL + 1
  93.           ICEL(1,NCEL) = I
  94.           ICEL(2,NCEL) = J
  95.           IF(I.NE.IB.OR.J.NE.JB) THEN
  96.              IF (iarr.LT.0)  THEN
  97.                J = J - 1
  98.                iarr = iarr + NDI
  99.              ELSE
  100.                  IF (iarr.EQ.0)  THEN
  101.                    I = I + 1
  102.                    J = J - 1
  103.                    iarr = NDI - NDJ
  104.                  ELSE
  105. C                iarr.GT.0
  106.                      I = I + 1
  107.                      iarr = iarr - NDJ
  108.                  ENDIF
  109.              ENDIF
  110.              GOTO 11
  111.           ENDIF
  112.          ENDIF
  113.         ENDIF
  114.       ENDIF
  115.       IF (NCEL.EQ.1) THEN
  116.           KG(1) = K1(1)
  117.           KG(2) = K1(2)
  118.       ELSE
  119. C
  120.           KG(1)= (K1(1) + K2(1))/2
  121.           KG(2)= (K1(2) + K2(2))/2
  122. C
  123.       ENDIF
  124.       RETURN
  125.       END
  126.  
  127.  
  128.  
  129.  
  130.  

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