1 : C KAINTE SOURCE CHAT 05/01/13 00:50:34 5004 2 : SUBROUTINE KAINTE(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVUR,NAL,NM,AL,BL,KIMP) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C Include contenant quelques constantes dont XPI : 6 : -INC CCREEL 7 : C********************************************************************* 8 : C SP appele par KAVOTH 9 : C 10 : C - RECHERCHE DE L INTERSECTION DU SEGMENT (RA,ZA),(RB,ZB) 11 : C POTENTIELLEMENT OBSTRUCTEUR 12 : C AVEC LE TRIANGLE DEFINI PAR LES POINTS D INTEGRATION SPATIALE 13 : C (R1,Z1) (R2,Z2) 14 : C 15 : C - MISE A JOUR DES INTERVALLES D INTEGRATION 16 : C 17 : C entree: 18 : C R1,Z1 : POINT D INTEGRATION SUR LA FACE 1 19 : C R2,Z2 : POINT D INTEGRATION SUR LA FACE 2 20 : C RA,ZA : PREMIER POINT DU SEGMENT OBSTRUCTEUR 21 : C RB,ZB : SECOND 22 : C sortie 23 : C KVUR : 0 SI OBSTRUCTION TOTALE,2 SI PARTIELLE,1 SINON 24 : C AL : INTERVALLES D INTEGRATION ANGULAIRE 25 : C BL : TABLEAU DE TRAVAIL (SAUVEGARDE DE AL) 26 : C NAL : NOMBRE D INTERVALLES 27 : C********************************************************************* 28 : DIMENSION AL(2,NM),BL(2,NM) 29 : C 30 : C>> POINT INTERIEUR SI A COMPRIS ENTRE -1 ET 1 31 : C KAFINT(R1,Z1,R2,Z2,R,Z) 32 : C 33 : C>> SEGMENT TANGENT SI A COMPRIS ENTRE -1 ET 1.D0 34 : C KAFTAN(R1,Z1,RA,ZA,RB,ZB) 35 : C 36 : C ON ENLEVE L INTERVALLE (TMIN,TMAX) 37 : 38 : EMIN=1.D-5 39 : EMIN1=-1.D-5 40 : CMIN=1.D0-EMIN 41 : TMIN=0.D0 42 : TMAX=XPI 43 : KVUR=1 44 : 45 : C>> segment horizontal 46 : 47 : IF(DABS(Z2-Z1).LE.EMIN) THEN 48 : PROD=(Z1-ZA)*(Z1-ZB) 49 : IF (PROD.GE.EMIN) THEN 50 : IF(KIMP.GE.4)WRITE(6,*) ' MEME COTE: TOUT VU ' 51 : KVUR=1 52 : 53 : ELSEIF(DABS(R2-R1).LE.EMIN) THEN 53 : CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) 54 : IF(RI.LT.R1) THEN 54 : CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1) 55 : IF(DABS(A1).LE.CMIN) THEN 56 : KVUR=2 57 : TMIN=2*DACOS(A1) 58 : IF(KIMP.GE.4)WRITE(6,*) ' COTE OPPOSE CACHE TMIN ' 59 : $ ,TMIN 60 : 61 : ELSE 62 : KVUR=1 63 : IF(KIMP.GE.4)WRITE(6,*) ' SEG HORIZ : PT TG ' 64 : RETURN 65 : ENDIF 66 : ENDIF 67 : ELSE 67 : CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) 68 : 69 : IF (KM.EQ.1) THEN 70 : KVUR=0 71 : RETURN 72 : ENDIF 73 : 74 : ENDIF 75 : 76 : ELSE 77 : 78 : C>> segment non horizontal 79 : 79 : CALL KAFINT(R1,Z1,R2,Z2,RA,ZA,A) 79 : CALL KAFINT(R1,Z1,R2,Z2,RB,ZB,B) 80 : IF (DABS(A).LE.CMIN)THEN 81 : TA=DACOS(A) 82 : IF(KIMP.GE.4) WRITE(6,*) ' POINT A INTERIEUR : ANGLE ',TA 83 : ENDIF 84 : 85 : IF (DABS(B).LE.CMIN)THEN 86 : TB=DACOS(B) 87 : IF(KIMP.GE.4) WRITE(6,*) ' POINT B INTERIEUR : ANGLE ',TB 88 : ENDIF 89 : 90 : IF (DABS(A).LE.CMIN)THEN 91 : IF (DABS(B).LE.CMIN)THEN 92 : C>> 2 points interieurs 93 : 93 : CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP) 94 : IF(KVV.NE.0) THEN 95 : TMIN= TC 96 : TMAX= DMAX1(TA,TB) 97 : IF(TMIN.GT.TMAX) WRITE(6,*) ' KAINTE ERREUR ' 98 : ELSE 99 : TMIN= DMIN1(TA,TB) 100 : TMAX= DMAX1(TA,TB) 101 : ENDIF 102 : KVUR=2 103 : 104 : ELSE 105 : 106 : C>> point A interieur B exterieur 107 : 108 : IF(KIMP.GE.4)WRITE(6,*) ' POINT A INTERIEUR B EXTERIEUR' 109 : KVUR=2 109 : CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) 110 : IF (KM.EQ.1) THEN 111 : C>> intersection avec le cote M1M2 112 : IF(KIMP.GE.4) WRITE(6,*) ' M1M2 ',TA 113 : IF(KA.EQ.1) THEN 114 : TMAX=TA 115 : ELSE 116 : TMIN=TA 117 : ENDIF 118 : ELSE 119 : IF(KIMP.GE.4) WRITE(6,*) ' NON M1M2 ',TA 120 : TMIN=TA 120 : CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP) 121 : IF(KVV.NE.0) TMIN=DMIN1(TMIN,TC) 122 : ENDIF 123 : 124 : ENDIF 125 : ELSE 126 : 127 : IF (DABS(B).LE.CMIN)THEN 128 : 129 : C>> point A exterieur B interieur 130 : 131 : IF(KIMP.GE.4)WRITE(6,*) ' POINT A EXTERIEUR B INTERIEUR' 132 : KVUR=2 132 : CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) 133 : IF (KM.EQ.1) THEN 134 : IF(KIMP.GE.4) WRITE(6,*) ' M1M2 ',TB 135 : C>> intersection avec le cote M1M2 136 : IF(KA.EQ.1) THEN 137 : TMAX=TB 138 : ELSE 139 : TMIN=TB 140 : ENDIF 141 : ELSE 142 : IF(KIMP.GE.4) WRITE(6,*) ' NON M1M2 ',TB 143 : TMIN=TB 143 : CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP) 144 : IF(KVV.NE.0) TMIN=DMIN1(TMIN,TC) 145 : ENDIF 146 : 147 : ELSE 148 : 149 : C>> points A et B exterieurs 150 : 151 : IF(KIMP.GE.4)WRITE(6,*) ' POINT A ET B EXTERIEURS' 152 : 152 : CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) 153 : IF (KM.EQ.1) THEN 154 : IF(KA.EQ.1) THEN 155 : KVUR=0 156 : RETURN 157 : ELSE 158 : KVUR=1 159 : ENDIF 160 : ELSE 161 : 161 : CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1) 161 : CALL KAFTAN(R2,Z2,RA,ZA,RB,ZB,A2) 162 : 163 : IF(DABS(A1).LE.CMIN.AND.DABS(A2).LE.CMIN) THEN 164 : C>> existence du point tangent 165 : TA1=DACOS(A1) 166 : TA2=DACOS(A2) 167 : RD=R1*DSIN(TA1)+R2*DSIN(TA2) 168 : RC=R1*R2*DSIN(TA1+TA2)/RD 169 : ZC=(Z1*R2*DSIN(TA2)+Z2*R1*DSIN(TA1))/RD 169 : CALL KAFINT(R1,Z1,R2,Z2,RC,ZC,AC) 170 : IF(DABS(AC).LE.1.D0) THEN 171 : C >> le point tangent appartient au triangle 172 : TC=TA1+TA2 173 : IF(KIMP.GE.4) THEN 174 : WRITE(6,*) ' RA ZA ',RA,ZA 175 : WRITE(6,*) ' RB ZB ',RB,ZB 176 : WRITE(6,*) ' RC ZC ',RC,ZC 177 : ENDIF 178 : PC=(RC-RA)*(RC-RB)+(ZC-ZA)*(ZC-ZB) 179 : C >> le point tangent est a l interieur du segment AB 180 : IF(PC.LT.EMIN1) THEN 181 : KVUR=2 182 : TMIN=TC 183 : IF(KIMP.GE.4)WRITE(6,*) 184 : $ ' POINT TANGENT ANGLE ',TC 185 : ELSE 186 : KVUR=1 187 : IF(KIMP.GE.4)WRITE(6,*) 188 : $ ' SEGMENT EXTERIEUR : TOUT VU ' 189 : ENDIF 190 : 191 : ELSE 192 : IF(KIMP.GE.4)WRITE(6,*) ' PT TGT EXT : TOUT VU ' 193 : KVUR=1 194 : ENDIF 195 : ELSE 196 : C>> pas de point tangent 197 : KVUR=1 198 : IF(KIMP.GE.4)WRITE(6,*) ' PAS DE PT TGT: TOUT VU ' 199 : ENDIF 200 : ENDIF 201 : 202 : ENDIF 203 : ENDIF 204 : 205 : ENDIF 206 : 207 : C>> mise a jour des intervalles d integration 208 : 209 : IF(KVUR.EQ.2.AND.DABS(TMAX-TMIN).GE.EMIN) THEN 210 : IF (KIMP.GE.4) THEN 211 : WRITE(6,*) ' AVANT KARSET KVU MIN MAX ',KVUR,TMIN,TMAX 212 : ENDIF 212 : CALL KARSET(AL,BL,NAL,NM,TMIN,TMAX,KVU) 213 : 214 : KVUR=KVU 215 : ENDIF 216 : 217 : RETURN 218 : END 219 : 220 : 221 : 222 : 223 :
© Cast3M 2003 - All rights reserved.
Disclaimer