Télécharger la plaquette Cast3M


fr en

Télécharger trdbse.eso

Retour à la liste

Numérotation des lignes : 

trdbse

  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)
  32. C      CALL G2DDRO2P( XN, DROITE ) REMPLACE PAR O.STAB
  33.       CALL DR2PO( COORD((NN(1)-1)*IDIMC+1),
  34.      >                COORD((NN(2)-1)*IDIMC+1),DROITE,IERR)
  35. C
  36. C     --- RECHERCHE DE L'ELEMENT DE DEPART ---
  37. C     --------------------------------------------
  38.       ISENS = 1
  39.       CALL SESFR2(NN,ISENS,IDE,ITRNOE,NBNMAX,ITRTRI,
  40.      >                     NBCMAX,NOETRI,ITP,IAR)
  41.       IF((IAR.EQ.-1).OR.(ITP.EQ.0))GO TO 999
  42.       ITPDEB = ITP
  43.       IARDEB = IAR
  44. C
  45. C     --- TEST D'INTERSECTION : L'ARETE OPPOSEE ---
  46. C
  47.    20 I = IAR
  48.       N2 = ITRNOE((ITP-1)*NBNMAX+I)
  49.       X(2) = COORD((N2-1)*IDIMC + 1)
  50.       Y(2) = COORD((N2-1)*IDIMC + 2)
  51.       I = MOD(I,3)+1
  52.       I = MOD(I,3)+1
  53.       N1 = ITRNOE((ITP-1)*NBNMAX+I)
  54.       X(1) = COORD((N1-1)*IDIMC + 1)
  55.       Y(1) = COORD((N1-1)*IDIMC + 2)
  56. C
  57.       S1 = DROITE(1)*X(1)+DROITE(2)*Y(1)+DROITE(3)
  58.       S2 = DROITE(1)*X(2)+DROITE(2)*Y(2)+DROITE(3)
  59.       IF(((S1.GT. PZERO).AND.(S2.LT.-PZERO)).OR.
  60.      >   ((S1.LT.-PZERO).AND.(S2.GT. PZERO)))THEN
  61. C        --- VERIFICATION DU COTE : PRSCAL > 0---
  62.          S1 = ((X(1)-XN(1))*(XN(4)-XN(2))) -
  63.      >        ((Y(1)-XN(2))*(XN(3)-XN(1)))
  64.          S2 = ((X(1)-XN(1))*(Y(2)-Y(1))) -
  65.      >        ((Y(1)-XN(2))*(X(2)-X(1)))
  66.          IF( (S1*S2).GT.PZERO )THEN
  67.          IAR = I
  68.          GOTO 999
  69.          ENDIF
  70.       ENDIF
  71. C     --- ON PASSE AU TRIANGLE SUIVANT ---
  72.       IAR = MOD(IAR,NBCMAX)+1
  73.       CALL SESFR1(ITP,IAR,ITRTRI,NBCMAX,ITP,IAR)
  74.       IF((ITP.NE.ITPDEB ).AND.(ITP.NE.0))GOTO 20
  75.       ITP = 0
  76.       IAR = 0
  77.   999 END
  78.  
  79.  
  80.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales