Esope source files

   1 : C TRDBSE    SOURCE    CHAT      05/01/13    03:46:00     5004           
   2 :       SUBROUTINE TRDBSE(NN,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
   3 :      >                   NOETRI,COORD,ITP,IAR)
   4 : C     ******************************************************     
   5 : C     OBJET :  SELECTIONNE LE TRIANGLE INCIDENT A UN NOEUD
   6 : C              ET QUI INTERSECTE UNE DEMI-DROITE PARTANT 
   7 : C              DE CE NOEUD
   8 : C     EN ENTREE: 
   9 : C        NN() : LES INDICES DES NOEUDS DU SEGMENT
  10 : C     EN SORTIE: 
  11 : C        ITP  :  LE TRIANGLE INTERSECTANT NN
  12 : C        IAR  :  L'INDICE DE L'ARETE DE ITP INTERSECTEE PAR NN
  13 : C     NIVEAU  : FICHIER
  14 : C     ********************************************************
  15 :       IMPLICIT INTEGER(I-N)
  16 :       INTEGER   NN(*),ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  17 :       INTEGER   NOETRI(*),ITP,IAR
  18 :       REAL*8      COORD(*)
  19 : C
  20 :       REAL*8      XN(4), DROITE(3), PZERO, X(2),Y(2),S1,S2
  21 :       INTEGER   IDE,IDIMC,I
  22 :       INTEGER   ITPDEB,ISENS,IARDEB,N1,N2,IERR
  23 : C 
  24 : C     --- LE SEGMENT N'EST PAS RESPECTE ---
  25 :       IDIMC = 2
  26 :       IDE = 2
  27 :       DO 10 I=1,IDIMC
  28 :         XN(I)     = COORD((NN(1)-1)*IDIMC+I)
  29 :         XN(IDIMC+I)= COORD((NN(2)-1)*IDIMC+I)
  30 :    10 CONTINUE
  31 :       PZERO = 1.D-10 *((XN(3)-XN(1))**2 + (XN(4)-XN(2))**2)
  31 : C      CALL G2DDRO2P( XN, DROITE ) REMPLACE PAR O.STAB
  31 :       CALL DR2PO( COORD((NN(1)-1)*IDIMC+1),
  32 :      >                COORD((NN(2)-1)*IDIMC+1),DROITE,IERR)
  33 : C      
  34 : C     --- RECHERCHE DE L'ELEMENT DE DEPART ---
  35 : C     --------------------------------------------
  36 :       ISENS = 1
  36 :       CALL SESFR2(NN,ISENS,IDE,ITRNOE,NBNMAX,ITRTRI,
  37 :      >                     NBCMAX,NOETRI,ITP,IAR)
  38 :       IF((IAR.EQ.-1).OR.(ITP.EQ.0))GO TO 999
  39 :       ITPDEB = ITP
  40 :       IARDEB = IAR
  41 : C      
  42 : C     --- TEST D'INTERSECTION : L'ARETE OPPOSEE ---
  43 : C
  44 :    20 I = IAR
  45 :       N2 = ITRNOE((ITP-1)*NBNMAX+I)     
  46 :       X(2) = COORD((N2-1)*IDIMC + 1)
  47 :       Y(2) = COORD((N2-1)*IDIMC + 2)
  48 :       I = MOD(I,3)+1
  49 :       I = MOD(I,3)+1 
  50 :       N1 = ITRNOE((ITP-1)*NBNMAX+I)    
  51 :       X(1) = COORD((N1-1)*IDIMC + 1)
  52 :       Y(1) = COORD((N1-1)*IDIMC + 2)
  53 : C
  54 :       S1 = DROITE(1)*X(1)+DROITE(2)*Y(1)+DROITE(3)
  55 :       S2 = DROITE(1)*X(2)+DROITE(2)*Y(2)+DROITE(3)
  56 :       IF(((S1.GT. PZERO).AND.(S2.LT.-PZERO)).OR.
  57 :      >   ((S1.LT.-PZERO).AND.(S2.GT. PZERO)))THEN
  58 : C        --- VERIFICATION DU COTE : PRSCAL > 0---
  59 :          S1 = ((X(1)-XN(1))*(XN(4)-XN(2))) -
  60 :      >        ((Y(1)-XN(2))*(XN(3)-XN(1)))
  61 :          S2 = ((X(1)-XN(1))*(Y(2)-Y(1))) -
  62 :      >        ((Y(1)-XN(2))*(X(2)-X(1)))     
  63 :          IF( (S1*S2).GT.PZERO )THEN
  64 :          IAR = I
  65 :          GOTO 999
  66 :          ENDIF
  67 :       ENDIF
  68 : C     --- ON PASSE AU TRIANGLE SUIVANT --- 
  69 :       IAR = MOD(IAR,NBCMAX)+1  
  69 :       CALL SESFR1(ITP,IAR,ITRTRI,NBCMAX,ITP,IAR)
  70 :       IF((ITP.NE.ITPDEB ).AND.(ITP.NE.0))GOTO 20    
  71 :       ITP = 0
  72 :       IAR = 0
  73 :   999 END             
  74 :  
  75 :