Esope source files

   1 : C TRITSE    SOURCE    CHAT      05/01/13    03:48:00     5004           
   2 :       SUBROUTINE TRITSE(NN,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
   3 :      >                   NOETRI,NBE,COORD,INTER,NINTER)
   4 : C     *************************************************************
   5 : C     OBJET : DETECTE L'ENSEMBLE DES ELEMENTS INTERSECTANT UN SEGMENT 
   6 : C
   7 : C     EN ENTREE: 
   8 : C        NN() : LES INDICES DES NOEUDS DU SEGMENT
   9 : C
  10 : C        ITRTRI,NBNMAX,ITRNOE,NBCMAX,NOETRI,NBE,COORD : LE MAILLAGE
  11 : C
  12 : C        NINTER : TAILLE DU TABLEAU INTER
  13 : C
  14 : C     EN SORTIE: 
  15 : C        INTER  :  TABLEAU DES ELEMENTS INTERSECTANT NN
  16 : C                  ILS SONT ORDONNEES DE NN(1) VERS NN(2)
  17 : C        NINTER:  NOMBRE D'ELEMENTS INTERSECTANT NN
  18 : C                  -1 SI LE SEGMENT EST EXTERIEUR OU PASSE PAR UN NOEUD
  19 : C                  -2 SI INTER(NINTER) TROP PETIT
  20 : C     NIVEAU  : MODULE
  21 : C     *****************************************************************
  22 :       IMPLICIT INTEGER(I-N)
  23 :       INTEGER   NN(*),ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  24 :       INTEGER   NOETRI(*),NBE,INTER(*),NINTER
  25 :       REAL*8      COORD(*)
  26 : C
  27 :       REAL*8      XN(4), DROITE(3), PZERO, X(3),Y(3)
  28 :       INTEGER   NLO(3),NBNN,IDE,IDIMC,NBN,I,IT1,IT2,I1,I2,IERR
  29 :       INTEGER   ITD,IAD,ITF,IAF,ITS,IARET(3),NBA,ISOM(3),NBS,NS
  30 :       INTEGER   NINMAX
  31 : C 
  32 :       NINMAX = NINTER
  33 :       NINTER = 0
  34 :       IDE = 2
  35 :       NBNN = 2
  36 :       IDIMC = 2
  37 :       NBN = 3
  37 :       CALL SFRIDE(NN,NBNN,IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  38 :      >                   NOETRI,NBE,IT1,IT2,I1,I2)
  39 : C      
  40 :       IF((IT1.NE.0).OR.(IT2.NE.0))GO TO 999
  41 : C
  42 : C     --- LE SEGMENT N'EST PAS RESPECTE ---
  43 : C
  44 :       NLO(1) = NN(1)
  45 :       NLO(2) = NN(2)
  46 :       NLO(3) = NN(1)
  47 : C
  48 : C     --- RECHERCHE DU TRIANGLE DE DEPART ---
  49 : C
  49 :       CALL TRDBSE(NLO,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  50 :      >                   NOETRI,COORD,ITD,IAD)
  51 :       IF(ITD.EQ.0)GOTO 888
  52 :       NINTER=NINTER+1
  53 : C     ----- BUG_14 : 28.03.97 O.STAB ---
  54 :       IF( NINTER.GT. NINMAX )THEN
  55 :         NINTER = -2
  56 :         GOTO 999
  57 :       ENDIF
  58 :       INTER(NINTER)= ITD
  59 : C
  60 : C     --- RECHERCHE DU TRIANGLE D'ARRIVEE ---
  61 : C
  61 :       CALL TRDBSE(NLO(2),ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  62 :      >                   NOETRI,COORD,ITF,IAF)     
  63 :       IF(ITF.EQ.0)GOTO 888
  64 : C     -----------------------------------------
  65 :       DO 5 I=1,IDIMC
  66 :         XN(I)      = COORD((NN(1)-1)*IDIMC+I)
  67 :         XN(IDIMC+I)= COORD((NN(2)-1)*IDIMC+I)
  68 :    5  CONTINUE
  69 :       PZERO = 1.D-10 *((XN(3)-XN(1))**2 + (XN(4)-XN(2))**2)
  69 : C      CALL G2DDRO2P( XN, DROITE ) REMPLACE PAR O.STAB
  69 :       CALL DR2PO( COORD((NN(1)-1)*IDIMC+1),
  70 :      >                COORD((NN(2)-1)*IDIMC+1),DROITE,IERR)
  71 : C     -----------------------------------------      
  72 :       ITS = ITRTRI((ITD-1)*NBCMAX+IAD)
  73 : C     --------------------------------------------
  74 :    10 IF( ITS .EQ. ITF )GO TO 90
  75 :       NINTER=NINTER+1
  76 : C     ----- BUG_14 : 28.03.97 O.STAB ---
  77 :       IF( NINTER.GT. NINMAX )THEN
  78 :         NINTER = -2
  79 :         GOTO 999
  80 :       ENDIF
  81 :       INTER(NINTER)= ITS
  82 :       DO 20 I=1,NBN
  83 :         NS = ITRNOE((ITS-1)*NBNMAX+I)
  84 :         X(I)  = COORD((NS-1)*IDIMC+1)
  85 :         Y(I)  = COORD((NS-1)*IDIMC+2)
  86 :    20 CONTINUE
  86 :       CALL INDRPO(X,Y,NBN,DROITE,PZERO,NBA,IARET,NBS,ISOM)
  87 :       IF( NBA .NE.2 )GOTO 888
  88 :       IF( ITRTRI((ITS-1)*NBCMAX+IARET(1)).EQ.INTER(NINTER-1))THEN
  89 :         ITS = ITRTRI((ITS-1)*NBCMAX+IARET(2))
  90 :       ELSE
  91 :         ITS = ITRTRI((ITS-1)*NBCMAX+IARET(1))
  92 :       ENDIF
  93 :       GO TO 10
  94 : C     --- ON A FINI ---
  95 :    90 NINTER=NINTER+1
  96 : C     ----- BUG_14 : 28.03.97 O.STAB ---
  97 :       IF( NINTER.GT. NINMAX )THEN
  98 :         NINTER = -2
  99 :         GOTO 999
 100 :       ENDIF
 101 :       INTER(NINTER)= ITF
 102 :       GOTO 999
 103 :   888 NINTER= -1
 104 :   999 END
 105 :  
 106 :