Esope source files

   1 : C RF2RAR    SOURCE    CHAT      06/03/29    21:31:27     5360           
   2 :       SUBROUTINE RF2RAR(NN,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
   3 :      >                    NOETRI,NBE,COORD,
   4 :      >                    ITVL,NTIMAX,RTVL,NTRMAX,
   5 :      >                    NBENEW,iarr)
   6 : C     *****************************************************************
   7 : C     OBJET : IMPOSE LE RESPECTER D'UNE ARETE A UN MAILLAGE TRIANGULAIRE
   8 : C
   9 : C     EN ENTREE: 
  10 : C        NN()    :  LES INDICES DES NOEUDS DE L'ARETE
  11 : C
  12 : C        ITRTRI,NBNMAX,ITRNOE,NBCMAX,NOETRI,NBE,COORD : LE MAILLAGE
  13 : C
  14 : C        ITVL   :  TABLEAU DE TRAVAIL (ENTIERS)
  15 : C        NTIMAX :  TAILLE DU TABLEAU ITVL
  16 : C        RTVL   :  TABLEAU DE TRAVAIL (REELS)
  17 : C
  18 : C        NTRMAX :  TAILLE DU TABLEAU RTVL
  19 : C          AU MINIMUM = 9 * NINTER + 10
  20 : C          AU MAXIMUM = (NBR MAX D'ELEMENTS EN 1 NOEUD + 1) *
  21 : C                        NUMERO MAXI DU NOEUD DANS ITRNOE
  22 : C
  23 : C     EN SORTIE: LE MAILLAGE MODIFIE SI NECESSAIRE.
  24 : C
  25 : C        NBENEW: LE NOMBRE DE TRIANGLES MODIFIES
  26 : C                ILS ONT LES NUMERO 1 A NBENEW
  27 : C
  28 : C        iarr  :  0 SI OK
  29 : C          -1 SI L'ARETE EST EXTERIEURE OU PASSE PAR UN NOEUD
  30 : C          -2 SI LE NOMBRE DE TRIANGLES INTERSECTES EST TROP GRAND
  31 : C             PEUT ETRE ITVL EST TROP PETIT
  32 : C     *****************************************************************
  33 :       IMPLICIT INTEGER(I-N)
  34 :       INTEGER   NN(*),ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  35 :       INTEGER   NOETRI(*),NBE,ITVL(*),NTIMAX,NTRMAX
  36 :       REAL*8      COORD(*), RTVL(*)
  37 :       INTEGER   NBENEW,iarr
  38 : C
  39 :       INTEGER   NINTER,ITRAV,INTER
  40 : C        =================================================
  41 : C     --- 1. CALCUL DES TRIANGLES INTERSECTANT LE SEGMENT ---
  42 : C        =================================================
  43 : C     ITVL = | INTER |
  44 : C                 NINTER    
  45 : C 
  46 :       iarr = 0
  47 :       INTER = 1
  48 :       NINTER = NTIMAX
  48 :       CALL TRITSE(NN,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  49 :      >               NOETRI,NBE,COORD,ITVL(INTER),NINTER)
  50 : C      WRITE(6,*) 'SORTIE TRISTE ninter = ',NINTER
  51 :       NBENEW = NINTER
  52 :       IF( NINTER .EQ. 0 ) GO TO 999
  53 : C     ---- BUG_14 O.STAB 28.03.97 ----
  54 :       IF( NINTER .LT. 0 )THEN
  55 :        iarr = NINTER
  56 :        GO TO 999
  57 :       ENDIF
  58 : C              ====================
  59 : C       ------- 2.FORCAGE OPTIMUM  ----------
  60 : C              ====================
  61 :         ITRAV = NINTER + INTER
  61 :         CALL RF2FAR(NN,ITVL(INTER),NINTER, 
  62 :      >                ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  63 :      >                NOETRI,NBE,COORD,ITVL(ITRAV),
  64 :      >                (NTIMAX-NINTER),RTVL,NTRMAX,iarr)
  65 : C       
  66 : C      WRITE(6,*) 'SORTIE RF2FAR iarr = ',iarr
  67 :   999 END
  68 :  
  69 :  
  70 :