Télécharger la plaquette Cast3M


fr en

Télécharger sesfr2.eso

Retour à la liste

Numérotation des lignes : 

sesfr2

  1. C SESFR2    SOURCE    CHAT      05/01/13    03:14:23     5004
  2.       SUBROUTINE SESFR2(NN,ISENS,IDE,ITRNOE,NBNMAX,ITRTRI,
  3.      >                     NBCMAX,NOETRI,ITP,IAR)
  4. C     ************************************************************
  5. C     OBJET : ELEMENT PREMIER SUR FRONTIERE IDE-2
  6. C        TRIANGLE PREMIER SUR SOMMET / TETRA PREMIER SUR ARETE
  7. C        RECHERCHE DU TRIANGLE DE DEPART ET DE SON ARETE POUR
  8. C        TOURNER AUTOUR D'UN SOMMET DANS UN SENS DONNE
  9. C     EN ENTREE:
  10. C      NN     :  LE SOMMET OU L'ARETE SUR LEQUEL ON TOURNE
  11. C      ISENS  :  LE SENS DANS LEQUEL ON VEUT TOURNER
  12. C     EN SORTIE:
  13. C      ITP :  LE TRIANGLE DE DEPART
  14. C      IAR :  INDICE DE L'ARETE DE DEPART POUR LE TRIANGLE IPT
  15. C             -1 SI "NN" N'APPARTIENT PAS A L'ELEMENT
  16. C     ************************************************************
  17.       IMPLICIT INTEGER(I-N)
  18.       INTEGER   NN(*),ISENS,IDE,ITRNOE(*),NBNMAX,ITRTRI(*)
  19.       INTEGER   NBCMAX,NOETRI(*),ITP,IAR
  20. C
  21.       INTEGER   IT,J,K,IDEBUT,IAR1,NBRN, NBNE
  22.       INTEGER  STRNBN
  23.       EXTERNAL STRNBN
  24. C
  25.       ITP = 0
  26.       IDEBUT = NOETRI(NN(1))
  27.       IT = IDEBUT
  28. C
  29. C     --- ON RECHERCHE LE PREMIER NOEUD : NN ---
  30. C
  31.       IAR = 0
  32.       IAR1 = 0
  33.       DO 10 J=1,NBNMAX
  34.         IF(ITRNOE((IT-1)*NBNMAX+J) .EQ. NN(1))THEN
  35.           IF( IDE .EQ. 2 )THEN
  36. C           SENS INDIRE => ARETE ARRIVANT AU NOEUD => ARETE PREC
  37. C           ----------------------------------------------------
  38. C            IAR1 = MOD(J+(NBNMAX-2),NBNMAX)+1
  39. C           REMPLACER PAR O.STAB BUG 8 :
  40. C
  41.             IF( NBNMAX.EQ.3 )THEN
  42.               IAR1 = MOD(J+(NBNMAX-2),NBNMAX)+1
  43.             ELSE
  44.               NBNE = STRNBN(IT,ITRNOE,NBNMAX)
  45.               IAR1 = MOD(J+(NBNE-2),NBNE)+1
  46.             ENDIF
  47. C            IAR1 = J
  48.             GO TO 20
  49.           ELSE
  50. C         --- CAS 3D ---
  51.             DO 3 K=1,NBNMAX
  52.               IF( ITRNOE((IT-1)*NBNMAX+K).EQ.0 )GO TO 4
  53.     3       CONTINUE
  54.     4       NBRN = K
  55.             DO 5 K=1,NBRN
  56.              IF(ITRNOE((IT-1)*NBNMAX+K) .EQ. NN(2))THEN
  57. C            --- FACE DIRECTE OU INDIRECTE INCIDENTE A L'ARETE JK
  58.                CALL S3FDIA(J,K,NBRN,IAR1)
  59.                GO TO 20
  60.              ENDIF
  61.     5       CONTINUE
  62.           ENDIF
  63.         ENDIF
  64.    10 CONTINUE
  65. C     ---- ON A PAS TROUVER L'ARETE OU LA FACE ---
  66.       IAR = -1
  67.       GO TO 999
  68. C
  69.    20 ITP = IT
  70.       IAR = IAR1
  71. C      IF( ISENS .EQ. 1)IAR = MOD(IAR+(NBNMAX-2),NBNMAX)+1
  72.       CALL SESFR1(ITP,IAR,ITRTRI,NBCMAX,IT,IAR1)
  73.       IF( IT .EQ. 0 )GO TO 999
  74. C     --- ON PASSE AU TRIANGLE SUIVANT,ARETE PREC ---
  75. C      IAR1 = MOD(IAR1+(NBNMAX-2),NBNMAX)+1
  76. C           REMPLACER PAR O.STAB BUG 8 :
  77. C
  78.       IF( NBNMAX.EQ.3 )THEN
  79.         IAR1 = MOD(IAR1+(NBNMAX-2),NBNMAX)+1
  80.       ELSE
  81.         NBNE = STRNBN(IT,ITRNOE,NBNMAX)
  82.         IAR1 = MOD(IAR1+(NBNE-2),NBNE)+1
  83.       ENDIF
  84.       IF( IT .NE. IDEBUT )GO TO 20
  85.  
  86.   999 END
  87.  
  88.  
  89.  

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