Sources Esope | Cast3M

kainte
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