Sources Esope | Cast3M

kbrese
C KBRESE    SOURCE    CHAT      06/03/29    21:23:37     5360
      SUBROUTINE  KBRESE(K1,K2,NCEL,ICEL,KG)                            KPR02890
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C Calcul des facteurs de forme en 3D
C Sp appele par KPARC                                                   KPR02900
C                                                                       KPR02900
C Detarmination des cellules interceptées par la droite
C reliant 2 cellules. Algorithme de Bresenham
C     NCEL : NOMBRE DE CELLULES  APPROCHANT LE SEGMENT (K1,K2)          KPR02910
C     ICEL : COORDONNEES CORRESPONDANTES                                KPR02920
C                                                                       KPR02930
C                                                                       KPR02940
      DIMENSION K1(2),K2(2),ICEL(2,1),KG(2)                             KPR02950
      I1 = K1(1)                                                        KPR02960
      J1 = K1(2)                                                        KPR02970
      I2 = K2(1)                                                        KPR02980
      J2 = K2(2)                                                        KPR02990
C                                                                       KPR03000
      NDI=IABS(I2-I1)                                                   KPR03010
      NDJ=IABS(J2-J1)                                                   KPR03020
      IF (NDI.EQ.0) THEN                                                KPR03030
         IF(NDJ.EQ.0) THEN                                              KPR03040
             NCEL = 1                                                   KPR03050
             ICEL(1,1) = I1                                             KPR03060
             ICEL(2,1) = J1                                             KPR03070
         ELSE                                                           KPR03080
             NCEL = NDJ+1                                               KPR03090
             JA = MIN0(J1,J2)                                           KPR03100
             DO 1 J=1,NCEL                                              KPR03110
             ICEL(1,J) = I1                                             KPR03120
             ICEL(2,J) = JA+J-1                                         KPR03130
 1           CONTINUE                                                   KPR03140
         ENDIF                                                          KPR03150
      ELSE                                                              KPR03160
        IF(NDJ.EQ.0) THEN                                               KPR03170
             NCEL = NDI+1                                               KPR03180
             IA = MIN0(I1,I2)                                           KPR03190
             DO 2 I=1,NCEL                                              KPR03200
             ICEL(1,I) = IA + I - 1                                     KPR03210
             ICEL(2,I) = J1                                             KPR03220
  2          CONTINUE                                                   KPR03230
        ELSE                                                            KPR03240
C                                                                       KPR03250
         IF (I1.GT.I2)   THEN                                           KPR03260
             IA=I2                                                      KPR03270
             JA=J2                                                      KPR03280
             IB=I1                                                      KPR03290
             JB=J1                                                      KPR03300
         ELSE                                                           KPR03310
             IA=I1                                                      KPR03320
             JA=J1                                                      KPR03330
             IB=I2                                                      KPR03340
             JB=J2                                                      KPR03350
         ENDIF                                                          KPR03360
C                                                                       KPR03370
C CAS GENERAL                                                           KPR03380
C                                                                       KPR03390
         IF(JB.GT.JA) THEN                                              KPR03470
          I= IA                                                         KPR03480
          J= JA                                                         KPR03490
          iarr=0                                                        KPR03500
          NCEL = 0                                                      KPR03510
  10      CONTINUE                                                      KPR03520
          NCEL = NCEL + 1                                               KPR03530
          ICEL(1,NCEL) = I                                              KPR03540
          ICEL(2,NCEL) = J                                              KPR03550
          IF(I.NE.IB.OR.J.NE.JB) THEN                                   KPR03560
             IF (iarr.GT.0)  THEN                                       KPR03570
               J = J + 1                                                KPR03580
               iarr = iarr - NDI                                        KPR03590
             ELSE                                                       KPR03600
                 IF (iarr.EQ.0)  THEN                                   KPR03610
                   I = I + 1                                            KPR03690
                   J = J + 1                                            KPR03700
                   iarr = NDJ - NDI                                     KPR03710
                 ELSE                                                   KPR03720
C                iarr.LT.0                                              KPR03730
                     I = I + 1                                          KPR03740
                     iarr = iarr + NDJ                                  KPR03750
                 ENDIF                                                  KPR03760
             ENDIF                                                      KPR03770
             GOTO 10                                                    KPR03780
          ENDIF                                                         KPR03790
C    PENTE INVERSE                                                      KPR03800
         ELSE                                                           KPR03810
          I= IA                                                         KPR03820
          J= JA                                                         KPR03830
          iarr=0                                                        KPR03840
          NCEL = 0                                                      KPR03850
  11      CONTINUE                                                      KPR03860
          NCEL = NCEL + 1                                               KPR03870
          ICEL(1,NCEL) = I                                              KPR03880
          ICEL(2,NCEL) = J                                              KPR03890
          IF(I.NE.IB.OR.J.NE.JB) THEN                                   KPR03900
             IF (iarr.LT.0)  THEN                                       KPR03910
               J = J - 1                                                KPR03920
               iarr = iarr + NDI                                        KPR03930
             ELSE                                                       KPR03940
                 IF (iarr.EQ.0)  THEN                                   KPR03950
                   I = I + 1                                            KPR04030
                   J = J - 1                                            KPR04040
                   iarr = NDI - NDJ                                     KPR04050
                 ELSE                                                   KPR04060
C                iarr.GT.0                                              KPR04070
                     I = I + 1                                          KPR04080
                     iarr = iarr - NDJ                                  KPR04090
                 ENDIF                                                  KPR04100
             ENDIF                                                      KPR04110
             GOTO 11                                                    KPR04120
          ENDIF                                                         KPR04130
         ENDIF                                                          KPR04140
        ENDIF                                                           KPR04150
      ENDIF                                                             KPR04160
      IF (NCEL.EQ.1) THEN                                               KPR04170
          KG(1) = K1(1)                                                 KPR04180
          KG(2) = K1(2)                                                 KPR04190
      ELSE                                                              KPR04200
C                                                                       KPR04220
          KG(1)= (K1(1) + K2(1))/2                                      KPR04230
          KG(2)= (K1(2) + K2(2))/2                                      KPR04240
C                                                                       KPR04250
      ENDIF                                                             KPR04290
      RETURN                                                            KPR04300
      END                                                               KPR04310