C KAINTE SOURCE CB215821 17/11/30 21:16:34 9639 SUBROUTINE KAINTE(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVUR,NAL,NM,AL,BL,KIMP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C Include contenant quelques constantes dont XPI : -INC CCREEL C********************************************************************* C SP appele par KAVOTH C C - RECHERCHE DE L INTERSECTION DU SEGMENT (RA,ZA),(RB,ZB) C POTENTIELLEMENT OBSTRUCTEUR C AVEC LE TRIANGLE DEFINI PAR LES POINTS D INTEGRATION SPATIALE C (R1,Z1) (R2,Z2) C C - MISE A JOUR DES INTERVALLES D INTEGRATION C C entree: C R1,Z1 : POINT D INTEGRATION SUR LA FACE 1 C R2,Z2 : POINT D INTEGRATION SUR LA FACE 2 C RA,ZA : PREMIER POINT DU SEGMENT OBSTRUCTEUR C RB,ZB : SECOND C sortie C KVUR : 0 SI OBSTRUCTION TOTALE,2 SI PARTIELLE,1 SINON C AL : INTERVALLES D INTEGRATION ANGULAIRE C BL : TABLEAU DE TRAVAIL (SAUVEGARDE DE AL) C NAL : NOMBRE D INTERVALLES C********************************************************************* DIMENSION AL(2,NM),BL(2,NM) C C>> POINT INTERIEUR SI A COMPRIS ENTRE -1 ET 1 C KAFINT(R1,Z1,R2,Z2,R,Z) C C>> SEGMENT TANGENT SI A COMPRIS ENTRE -1 ET 1.D0 C KAFTAN(R1,Z1,RA,ZA,RB,ZB) C C ON ENLEVE L INTERVALLE (TMIN,TMAX) EMIN=1.D-5 EMIN1=-1.D-5 CMIN=1.D0-EMIN TMIN=0.D0 TMAX=XPI KVUR=1 C>> segment horizontal IF(ABS(Z2-Z1).LE.EMIN) THEN PROD=(Z1-ZA)*(Z1-ZB) IF (PROD.GE.EMIN) THEN IF(KIMP.GE.4)WRITE(6,*) ' MEME COTE: TOUT VU ' KVUR=1 ELSEIF(ABS(R2-R1).LE.EMIN) THEN CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) IF(RI.LT.R1) THEN CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1) IF(ABS(A1).LE.CMIN) THEN KVUR=2 TMIN=2*ACOS(A1) IF(KIMP.GE.4)WRITE(6,*) ' COTE OPPOSE CACHE TMIN ' $ ,TMIN ELSE KVUR=1 IF(KIMP.GE.4)WRITE(6,*) ' SEG HORIZ : PT TG ' RETURN ENDIF ENDIF ELSE CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) IF (KM.EQ.1) THEN KVUR=0 RETURN ENDIF ENDIF ELSE C>> segment non horizontal CALL KAFINT(R1,Z1,R2,Z2,RA,ZA,A) CALL KAFINT(R1,Z1,R2,Z2,RB,ZB,B) IF (ABS(A).LE.CMIN)THEN TA=ACOS(A) IF(KIMP.GE.4) WRITE(6,*) ' POINT A INTERIEUR : ANGLE ',TA ENDIF IF (ABS(B).LE.CMIN)THEN TB=ACOS(B) IF(KIMP.GE.4) WRITE(6,*) ' POINT B INTERIEUR : ANGLE ',TB ENDIF IF (ABS(A).LE.CMIN)THEN IF (ABS(B).LE.CMIN)THEN C>> 2 points interieurs CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP) IF(KVV.NE.0) THEN TMIN= TC TMAX= MAX(TA,TB) IF(TMIN.GT.TMAX) WRITE(6,*) ' KAINTE ERREUR ' ELSE TMIN=MIN(TA,TB) TMAX= MAX(TA,TB) ENDIF KVUR=2 ELSE C>> point A interieur B exterieur IF(KIMP.GE.4)WRITE(6,*) ' POINT A INTERIEUR B EXTERIEUR' KVUR=2 CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) IF (KM.EQ.1) THEN C>> intersection avec le cote M1M2 IF(KIMP.GE.4) WRITE(6,*) ' M1M2 ',TA IF(KA.EQ.1) THEN TMAX=TA ELSE TMIN=TA ENDIF ELSE IF(KIMP.GE.4) WRITE(6,*) ' NON M1M2 ',TA TMIN=TA CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP) IF(KVV.NE.0) TMIN=MIN(TMIN,TC) ENDIF ENDIF ELSE IF (ABS(B).LE.CMIN)THEN C>> point A exterieur B interieur IF(KIMP.GE.4)WRITE(6,*) ' POINT A EXTERIEUR B INTERIEUR' KVUR=2 CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) IF (KM.EQ.1) THEN IF(KIMP.GE.4) WRITE(6,*) ' M1M2 ',TB C>> intersection avec le cote M1M2 IF(KA.EQ.1) THEN TMAX=TB ELSE TMIN=TB ENDIF ELSE IF(KIMP.GE.4) WRITE(6,*) ' NON M1M2 ',TB TMIN=TB CALL KAPTTG(R1,Z1,R2,Z2,RA,ZA,RB,ZB,KVV,TC,KIMP) IF(KVV.NE.0) TMIN=MIN(TMIN,TC) ENDIF ELSE C>> points A et B exterieurs IF(KIMP.GE.4)WRITE(6,*) ' POINT A ET B EXTERIEURS' CALL KAM1M2(R1,Z1,R2,Z2,RA,ZA,RB,ZB,RI,ZI,KM,KA) IF (KM.EQ.1) THEN IF(KA.EQ.1) THEN KVUR=0 RETURN ELSE KVUR=1 ENDIF ELSE CALL KAFTAN(R1,Z1,RA,ZA,RB,ZB,A1) CALL KAFTAN(R2,Z2,RA,ZA,RB,ZB,A2) IF(ABS(A1).LE.CMIN.AND.ABS(A2).LE.CMIN) THEN C>> existence du point tangent TA1=ACOS(A1) TA2=ACOS(A2) RD=R1*SIN(TA1)+R2*SIN(TA2) RC=R1*R2*SIN(TA1+TA2)/RD ZC=(Z1*R2*SIN(TA2)+Z2*R1*SIN(TA1))/RD CALL KAFINT(R1,Z1,R2,Z2,RC,ZC,AC) IF(ABS(AC).LE.1.D0) THEN C >> le point tangent appartient au triangle TC=TA1+TA2 IF(KIMP.GE.4) THEN WRITE(6,*) ' RA ZA ',RA,ZA WRITE(6,*) ' RB ZB ',RB,ZB WRITE(6,*) ' RC ZC ',RC,ZC ENDIF PC=(RC-RA)*(RC-RB)+(ZC-ZA)*(ZC-ZB) C >> le point tangent est a l interieur du segment AB IF(PC.LT.EMIN1) THEN KVUR=2 TMIN=TC IF(KIMP.GE.4)WRITE(6,*) $ ' POINT TANGENT ANGLE ',TC ELSE KVUR=1 IF(KIMP.GE.4)WRITE(6,*) $ ' SEGMENT EXTERIEUR : TOUT VU ' ENDIF ELSE IF(KIMP.GE.4)WRITE(6,*) ' PT TGT EXT : TOUT VU ' KVUR=1 ENDIF ELSE C>> pas de point tangent KVUR=1 IF(KIMP.GE.4)WRITE(6,*) ' PAS DE PT TGT: TOUT VU ' ENDIF ENDIF ENDIF ENDIF ENDIF C>> mise a jour des intervalles d integration IF(KVUR.EQ.2.AND.ABS(TMAX-TMIN).GE.EMIN) THEN IF (KIMP.GE.4) THEN WRITE(6,*) ' AVANT KARSET KVU MIN MAX ',KVUR,TMIN,TMAX ENDIF CALL KARSET(AL,BL,NAL,NM,TMIN,TMAX,KVU) KVUR=KVU ENDIF RETURN END