Sources Esope | Cast3M

sfride
C SFRIDE    SOURCE    CHAT      05/01/13    03:15:17     5004
      SUBROUTINE SFRIDE(NN,NBNN,IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
     >                   NOETRI,NBE,IT1,IT2,I1,I2)
C     *************************************************************
C     OBJET :  FRONTIERE IDE-1 COMMUNE AUX ELEMENTS
C        RECHERCHE DES TRIANGLES QUI PARTAGENT L'ARETE NN(1..2)
C        RECHERCHE DES TETRA. QUI PARTAGENT LE TRIANGLE NN(1..3)
C     EN ENTREE:
C      NN     :  TABLEAU DES SOMMETS DE L'ELEMENT FRONTIERE
C      NBNN   :  NOMBRE DE SOMMETS
C      IDE    :  DIMENSION DES ELEMENTS DU MAILLAGE
C      NBE    :  NOMBRE D'ELEMENTS DU MAILLAGE
C
C     EN SORTIE:
C      IT1 :  LE TRIANGLE QUI CONTIENT L'ARETE NN(1),NN(2)
C       I1 :  L'INDICE DE L'ARETE DE IT1 EGALE A NN(1),NN(2)
C      IT2 :  LE TRIANGLE QUI CONTIENT L'ARETE NN(2),NN(1)
C       I2 :  L'INDICE DE L'ARETE DE IT2 EGALE A NN(2),NN(1)
C
C     *************************************************************
      IMPLICIT INTEGER(I-N)
      INTEGER   NN(*),NBNN,IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
      INTEGER   NOETRI(*),NBE,IT1,IT2,I1,I2
C
      INTEGER   J1, J2, ISENS, IT, J, IDEBUT, NNT, ITAMPO
C
      IT1 = 0
      IT2 = 0
      I1 = 0
      I2 = 0
      ISENS = 1
 510  IDEBUT = NOETRI(NN(1))
      IT = IDEBUT
C
C     --- ON RECHERCHE LE PREMIER NOEUD : NN(1) ---
C
  500 J1 = 0
      DO 360 J=1,NBNMAX
        IF(ITRNOE((IT-1)*NBNMAX+J) .EQ. NN(1))J1 = J
  360 CONTINUE
      IF((J1.EQ.0).OR.(IDE.EQ.3))GO TO 999
C     ----------------------------------------------------
C     SENS DIRECT => ARETE PARTANT DU NOEUD N1
C     SENS INDIRE => ARETE ARRIVANT AU NOEUD => ARETE PREC
C     ----------------------------------------------------
      IF( ISENS .EQ. -1 )J1 = MOD(J1+(NBNMAX-2),NBNMAX)+1
C
      IF( IDE .EQ. 1 )THEN
C
C     --- INCIDENCE DE 2 ARETES SUR UN NOEUD ---
C
          IT1 = IT
          I1 = J1
          IT2 = ITRTRI((IT1-1)*NBCMAX+J1)
          IF( IT2 .EQ. 0 )GO TO 999
          IF( IT2 .LT. 0 )IT2 = -IT2
          DO 370 J=1,NBNMAX
            IF( NN(1) .EQ. ITRNOE((IT2-1)*NBNMAX+J))THEN
              I2 = J
              GOTO 999
            ENDIF
  370     CONTINUE
C         --- ERREUR ---
          GO TO 999
      ENDIF
C
C     --- INCIDENCE DE 2 TRIANGLES SUR UNE ARETE ---
C     --- ON RECHERCHE LE DEUXIEME NOEUD : NN(2) ---
C
C     --- CAS QUADRANGLES ---
      NNT = NBNMAX
      IF((IDE.EQ.2).AND.(NBNMAX.EQ.4).AND.
     >   (ITRNOE((IT-1)*NBNMAX+4).EQ.0))NNT =3
      IF( ISENS .EQ. 1 )THEN
C
C     --- ARETE PARTANT DU NOEUD N1 =>TEST DU NOEUD EXTREMITE
C
        J2 = MOD(J1,NNT)+1
      ELSE
C
C     --- ARETE ARRIVANT AU NOEUD N1 =>TEST DU NOEUD ORIGINE
C
        J2 = J1
      ENDIF
      IF( NN(2) .EQ. ITRNOE((IT-1)*NBNMAX+J2))THEN
          IT1 = IT
          I1 = J1
          IT2 = ITRTRI((IT1-1)*NBCMAX+J1)
          IF( IT2 .EQ. 0 )THEN
            IF( ISENS.EQ.1 )GOTO 999
C           --- BUG5 POUR RESPECTER L'ORIENTATION NN(1),NN(2)
            IT2 = IT1
            I2 = I1
            I1 = 0
            IT1 = 0
            GO TO 999
          ENDIF
          IF( IT2 .LT. 0 )IT2 = -IT2
          DO 380 J=1,NBNMAX
            IF((ISENS.EQ.1).AND.
     >        (NN(2).EQ.ITRNOE((IT2-1)*NBNMAX+J)))THEN
              I2 = J
              GOTO 999
            ENDIF
C           --- BUG5 POUR RESPECTER L'ORIENTATION NN(1),NN(2)
            IF((ISENS.EQ.-1).AND.
     >        (NN(1).EQ.ITRNOE((IT2-1)*NBNMAX+J)))THEN
              I2 = J
              ITAMPO = IT1
              IT1 = IT2
              IT2 = ITAMPO
              ITAMPO = I1
              I1 = I2
              I2 = ITAMPO
              GOTO 999
            ENDIF
  380     CONTINUE
C         --- ERREUR ---
          GOTO 999
      ENDIF
C     --- ON PASSE AU TRIANGLE SUIVANT ---
C      IF( ISENS .EQ. 1 )THEN
        IT = ITRTRI((IT-1)*NBCMAX+J1)
C      ELSE
C        IT = ITRTRI((IT-1)*NBCMAX+J2)
C      ENDIF
      IF( IT .EQ. 0 )THEN
        IF( ISENS .EQ. 1 )THEN
C     --- ON EST ARRIVE SUR LA FRONTIERE : ON CHANGE DE SENS ---
          ISENS = -1
          GO TO 510
        ELSE
C     --- ON ARRIVE SUR LA FRONTIERE EN TOURNANT DANS LES 2 SENS ---
          GOTO 999
        ENDIF
      ELSE IF( IT .LT. 0 )THEN
        IT = -IT
      ENDIF
      IF( IT .NE. IDEBUT )THEN
        GO TO 500
      ENDIF
  999 END