Esope source files

   1 : C SFAIDE    SOURCE    CHAT      05/01/13    03:15:04     5004           
   2 : C
   3 : C
   4 : C
   5 :       INTEGER FUNCTION SFAIDE( IT1, IT2, N1, N2, IDE, I1, I2 )
   6 : C     *****************************************************************
   7 : C     OBJET : RECHERCHE LA FACE COMMUME A 2 ELEMENTS
   8 : C         RENVOI LES INDICES I1 ET I2 CORRESPONDANTS AUX FRONTIERES
   9 : C         COMMUNES DES ELEMETS IT1 ET IT2. 
  10 : C     EN ENTREE:
  11 : C      IT1,IT2:  LES ELEMENTS A TESTER
  12 : C      N1     :  (2..4) NOMBRE DE NOEUDS DE IT1
  13 : C      N2     :  (2..4) NOMBRE DE NOEUDS DE IT2
  14 : C      IDE    :  (1..3) DIMENSION DES ELEMENTS
  15 : C     EN SORTIE: 
  16 : C      I1,I2  :  INDICES DES FRONTIERES COMMUNES
  17 : C      SFAIDE :  0 SI AUCUNE ARETE COMMUNE
  18 : C            -1 SI L'ARETE I1 ET L'ARETE I2 SONT PARCOURUS DANS LE MEME
  19 : C               SENS POUR IT1 ET IT2
  20 : C             1 SI "  "     "   "         "   "            DANS LE SENS
  21 : C               INVERSE
  22 : C     CONDITION D'APPLICATION : ARETE, TRIANGLE, QUADRANGLE, TETRA
  23 : C     REMARQUE : N'UTILISE PAS LA STRUCTURE DE DONNEES MAILLAGE
  24 : C                N'EXPLOITE AUCUNE HYPOTHESE SUR IT1 ET IT2
  25 : C     *****************************************************************
  26 :       IMPLICIT INTEGER(I-N)
  27 :       INTEGER IT1(N1), IT2(N2), N1,N2, IDE, I1, I2
  28 : C
  29 :       INTEGER I,J 
  30 :       EXTERNAL SFAC3D
  31 :       INTEGER  SFAC3D
  32 : C
  33 :       IF( IDE.EQ.2 )THEN
  34 : C     -----------------------
  35 : C     CAS DES TRIANGLES OU DES QUADRANGLES  
  36 : C     ON REALISE N1*N2*2  COMPARAISONS (X,Y) AVEC (A,B) ET (B,A)
  37 : C     ------------------------
  38 :       DO 10 I=1,N1 
  39 :         DO 20 J=1,N2 
  40 :           IF ( (IT1(I) .EQ. IT2(J))  .AND.
  41 :      >         (IT1(MOD(I,N1)+1) .EQ. IT2(MOD(J,N2)+1)) ) THEN
  42 :               I1 = I
  43 :               I2 = J
  44 :               SFAIDE = -1
  45 :               GOTO 999
  46 :           ENDIF
  47 :           IF( (IT1(I) .EQ. IT2(MOD(J,N2)+1))  .AND.
  48 :      >        (IT1(MOD(I,N1)+1) .EQ. IT2(J)) ) THEN
  49 :               I1 = I
  50 :               I2 = J
  51 :               SFAIDE = 1
  52 :               GOTO 999
  53 :           ENDIF    
  54 :    20   CONTINUE
  55 :    10 CONTINUE
  56 :       ELSE 
  57 :       IF( IDE.EQ.1)THEN
  58 : C     ------------------------
  59 : C     CAS DES ARETES : ON REALISE 4 COMPARAISONS (N1=N2=2)
  60 : C     ------------------------
  61 :       DO 30 I=1,N1 
  62 :         DO 40 J=1,N2
  63 :           IF (IT1(I) .EQ. IT2(J)) THEN
  64 :               I1 = I
  65 :               I2 = J
  66 :               IF( I.EQ.J )THEN
  67 :                    SFAIDE = -1
  68 :                 ELSE 
  69 :                    SFAIDE = 1
  70 :               ENDIF
  71 :               GOTO 999
  72 :           ENDIF
  73 :    40   CONTINUE
  74 :    30 CONTINUE
  75 :       ELSE 
  76 :       IF( IDE .EQ. 3 )THEN
  77 : C     ----------------------------
  78 : C     CAS DES TETRAEDRES : ON REALISE 4*4*6 = 96 COMPARAISONS
  79 : C     ----------------------------
  80 :         SFAIDE = SFAC3D( IT1, IT2, N1, N2, I1, I2 )
  81 :         GOTO 999
  82 :       ENDIF 
  83 :       ENDIF
  84 :       ENDIF        
  85 :       SFAIDE = 0         
  86 :   999 END                  
  87 :  
  88 :