Esope source files

   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 
  57 :                CALL S3FDIA(J,K,NBRN,IAR1)
  58 :                GO TO 20 
  59 :              ENDIF         
  60 :     5       CONTINUE
  61 :           ENDIF
  62 :         ENDIF
  63 :    10 CONTINUE
  64 : C     ---- ON A PAS TROUVER L'ARETE OU LA FACE ---
  65 :       IAR = -1 
  66 :       GO TO 999
  67 : C
  68 :    20 ITP = IT
  69 :       IAR = IAR1
  70 : C      IF( ISENS .EQ. 1)IAR = MOD(IAR+(NBNMAX-2),NBNMAX)+1
  70 :       CALL SESFR1(ITP,IAR,ITRTRI,NBCMAX,IT,IAR1)
  71 :       IF( IT .EQ. 0 )GO TO 999
  72 : C     --- ON PASSE AU TRIANGLE SUIVANT,ARETE PREC ---  
  73 : C      IAR1 = MOD(IAR1+(NBNMAX-2),NBNMAX)+1
  74 : C           REMPLACER PAR O.STAB BUG 8 :
  75 : C
  76 :       IF( NBNMAX.EQ.3 )THEN
  77 :         IAR1 = MOD(IAR1+(NBNMAX-2),NBNMAX)+1
  78 :       ELSE
  79 :         NBNE = STRNBN(IT,ITRNOE,NBNMAX)
  80 :         IAR1 = MOD(IAR1+(NBNE-2),NBNE)+1
  81 :       ENDIF
  82 :       IF( IT .NE. IDEBUT )GO TO 20       
  83 : 
  84 :   999 END        
  85 :  
  86 :