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 :
© Cast3M 2003 - All rights reserved.
Disclaimer