Esope source files

   1 : C S2GLAR    SOURCE    CHAT      05/01/13    03:10:13     5004           
   2 :       SUBROUTINE S2GLAR(IFR1,NBF1,IFR2,NBF2,ITRNOE,NBNMAX,
   3 :      >                     ITRTRI,NBCMAX,NBCCOL)
   4 : C     *****************************************************************
   5 : C     OBJET : COLLE LA FRONTIERE D'UN MAILLAGE SUR LA FRONTIERE D'UN 
   6 : C             DEUXIEME
   7 : C     EN ENTREE: 
   8 : C       IFR1 : FRONTIERE A COLLER
   9 : C       NBFR1: NOMBRE D'ELEMENTS DE LA FRONTIERE
  10 : C       IFR2 : FRONTIERE SUR LAQUELLE ON COLLE
  11 : C       NBFR2: NOMBRE D'ELEMENTS DE LA FRONTIERE
  12 : C       --- LE MAILLAGE ------------------------
  13 : C       ITRNOE,NBNMAX,ITRTRI,NBCMAX : LE MAILLAGE
  14 : C
  15 : C     EN SORTIE:  LE MAILLAGE MODIFIE (ITRTRI)
  16 : C       NBCCOL: LE NOMBRE D'ARETE DE IFR1 COLLEES A IFR2
  17 : C     REMARQUES : 
  18 : C        PAS DE VERIFICATION DE LA REGULARITE DE LA FRONTIERE
  19 : C        LES 2 MAILLAGES DOIVENT ETRE DANS LES MEMES TABLEAUX
  20 : C        ET ORIENTES DE LA MEME FACON.
  21 : C     COMPLEXITE : POUR CHAQUE AREET DE IFR1 ON PARCOURS TOUTES LES
  22 : C        ARETES DE IFR2
  23 : C     *****************************************************************
  24 :       IMPLICIT INTEGER(I-N)
  25 :       INTEGER IFR1(*),NBF1,IFR2(*),NBF2
  26 :       INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBCCOL
  27 : C
  28 :       INTEGER I,J,IT1,IT2,IF1,IF2,IORIG,IEXTR,NBRN1
  29 :       INTEGER ISENS
  30 :       INTEGER  STRNBN
  31 :       EXTERNAL STRNBN
  32 : C
  33 : C     --- MISE A JOUR DE ITRTRI -----------------
  34 : C
  35 :       NBCCOL = 0
  36 :       DO 20 I=1,NBF1
  37 :        NBRN1 = STRNBN(I,ITRNOE,NBNMAX)
  38 :        IT1 = IFR1((I-1)*2+1)
  39 :        IF1 = IFR1((I-1)*2+2)
  40 : C      --- POUR LES FRONTIERES INTERIEURES ---
  41 :        ISENS = 1
  42 :        IF( IF1.LT. 0 )THEN
  43 :          ISENS = -1
  44 :          IF1 = -IF1
  45 :        ENDIF
  46 :        IEXTR = ITRNOE((IT1-1)*NBNMAX+MOD(IF1,NBRN1)+1)
  47 :        DO 10 J=1,NBF2
  48 :          IT2 = IFR2((J-1)*2+1)
  49 :          IF2 = IFR2((J-1)*2+2)
  50 : C        --- POUR LES FRONTIERES INTERIEURES ---
  51 :          IF( IF2.LT. 0 )THEN
  52 :            ISENS = -1
  53 :            IF2 = -IF2
  54 :          ENDIF
  55 :          IORIG = ITRNOE((IT2-1)*NBNMAX+IF2)
  56 :          IF( IORIG .EQ. IEXTR )THEN
  57 :            ITRTRI((IT2-1)*NBCMAX+IF2) = ISENS * IT1
  58 :            ITRTRI((IT1-1)*NBCMAX+IF1) = ISENS * IT2
  59 :            NBCCOL = NBCCOL+1
  60 :            GO TO 20           
  61 :          ENDIF
  62 :    10  CONTINUE
  63 : C      --- ON EST SUR LA FRONTIERE ---
  64 :        ITRTRI((IT1-1)*NBCMAX+IF1) = 0
  65 :    20 CONTINUE
  66 :   999 END
  67 :  
  68 :