Sources Esope | Cast3M

sorien
C SORIEN    SOURCE    CHAT      06/03/29    21:34:32     5360
C
C
      SUBROUTINE SORIEN(IDE,ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE,
     >                  ITVL,NBITL,ITRAMA,NCC,iarr)
C     *****************************************************************
C     OBJET : ORIENTE UN MAILLAGE
C             LES ELEMENTS DE CHAQUE COMPOSANTE CONNEXE SONT ORIENTES
C             DE LA MEME FACON
C     EN ENTREE:
C      IDE    :  (1..3) DIMENSION DES ELEMENTS
C      ITRNOE:  LES NOEUDS DES ELEMENTS
C      NBNMAX :  (2..8) NOMBRE DE NOEUDS MAXIMUM DES ELEMENTS
C      ITRTRI:  LES VOISINS DES ELEMENTS
C      NBCMAX :  (2..6) NOMBRE DE COTES MAXIMUM DES ELEMENTS
C      NBE    :  NOMBRE D'ELEMENTS DU MAILLAGE
C      ITVL,NBITL : TABLEAU DE TRAVAIL NBITL &lt; (NBCMAX+1)*NBE
C      ITRAMA        : "    "   "    "  DE TAILLE = NBE
C     EN SORTIE:
C      ITRNOE: MIS A JOUR
C      ITRTRI: MIS A JOUR
C          NCC : NOMBRE DE COMPOSANTES CONNEXES
C         iarr : CODE D'ERREUR 0 => OK
C               -1 => DONNEES INCOHERENTES
C               -2 => TABLEAU ITVL EST TROP PETIT
C     CONDITION D'APPLICATION : ARETE, TRIANGLE, QUADRANGLE, TETRA
C     *****************************************************************
      IMPLICIT INTEGER(I-N)
      INTEGER    IDE,ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE
      INTEGER    ITVL(*),NBITL,ITRAMA(*),NCC,iarr
C
      DIMENSION ITT(7)
      EXTERNAL  SFAIDE
      INTEGER   SFAIDE
      INTEGER   I,J,ITT,NBTRA,IP,IM,NOP,II,N1,N2
C
      NCC = 0
      IF( NBE.EQ. 0 )GOTO 9999
      IF( NBE.LT. 0 )THEN
        iarr = -1
        GOTO 9999
      ENDIF
      IF( (NBCMAX+1).GT.NBITL )THEN
        iarr = -2
        GO TO 9999
      ENDIF
C
C     INITIALISATION
C     --------------
      DO 10 I=1,NBE
        ITRAMA(I) = 0
   10 CONTINUE
C
C     ON BOUCLE SUR LES COMPOSANTES CONNEXES
C     ---------------------------------------
C
      DO 70 I=1,NBE
      IF( ITRAMA(I) .EQ. 0 )THEN
      NCC = NCC + 1
      ITVL(1) = I
      DO 20 J=1,NBCMAX
        ITVL(J+1) = ITRTRI((I-1)*NBCMAX+J)
   20 CONTINUE
      ITRAMA(I)  = 1
      NBTRA = NBCMAX+1
C
C     ON BOUCLE TANTQUE ITVL N'EST PAS VIDE
C     ----------------------------------------
C
C     TRANSFERT DU PERE TT(N+1) ET DE SES N VOISINS
C     ---------------------------------------------
   30 DO 40 J=1,NBCMAX+1
        ITT(J)  = ITVL(NBTRA-J+1)
   40 CONTINUE
      NBTRA = NBTRA-(NBCMAX+1)
C
C     TRAITEMENT DES N VOISINS
C     ------------------------
      DO 60 J=1,NBCMAX
        IF(( ITT(J) .NE. 0 ) .AND. (ITRAMA(ITT(J)) .NE. 1 )) THEN
          N1 = NBNMAX
          N2 = NBNMAX
          IF((NBNMAX.EQ.4).AND.(IDE.EQ.2))THEN
C           --- CAS D'UN MAILLAGE MIXTE QUADRANGLES, TRIANGLES--
            IF(ITRNOE((ITT(J)-1)*NBNMAX+4).EQ.0)N1= 3
            IF(ITRNOE((ITT(NBCMAX+1)-1)*NBNMAX+4).EQ.0)N2= 3
          ENDIF
          NOP=SFAIDE(ITRNOE((ITT(J)-1)*NBNMAX+1),
     >      ITRNOE((ITT(NBCMAX+1)-1)*NBNMAX+1),N1,N2,IDE,IM,IP)
C           IL Y A UN BUG
C           -------------
            IF( NOP .EQ. 0 )THEN
              iarr = -1
              GO TO 9999
            ENDIF
            IF( NOP .LT. 0 ) THEN
              CALL SINVOR(IM,N1,IDE,ITRNOE((ITT(J)-1)*NBNMAX+1),
     >                    ITRTRI((ITT(J)-1)*NBCMAX+1))
            ENDIF
C     SES VOISINS SERONT A TRAITER
C     ----------------------------
            IF( (NBTRA+NBCMAX+1).GT.NBITL )THEN
              iarr = -2
              GO TO 9999
            ENDIF
            ITVL(NBTRA+1) = ITT(J)
            DO 50 II=1,NBCMAX
              ITVL(NBTRA+II+1) = ITRTRI(((ITT(J)-1)*NBCMAX)+II)
   50       CONTINUE
            NBTRA = NBTRA + (NBCMAX+1)
            ITRAMA(ITT(J)) = 1
          ENDIF
   60 CONTINUE
      IF( NBTRA .GT. NBITL )THEN
        iarr = -2
        GO TO 9999
        ENDIF
      IF( NBTRA .NE. 0 )GO TO 30
      ENDIF
   70 CONTINUE
 9999 END