Esope source files

   1 : C TRPLS2    SOURCE    CHAT      06/03/29    21:36:43     5360           
   2 :       SUBROUTINE TRPLS2(X,IPOLYG,NCP,
   3 :      >                  ITVL,NTIMAX,RTVL,NTRMAX,
   4 : C     >                  ITRPOL,FCRMIN,QTMIN,iarr)
   5 :      >                  ITRPOL,QTMIN,iarr)
   6 : C     *****************************************************************
   7 : C     OBJET : ALLOCATION DES TABLEAU DANS LA PILE (ITVL,RTVL) 
   8 : C             ET APPEL A TRPLSI
   9 : C
  10 : C     EN ENTREE :
  11 : C        X     : COORDONNEES DES POINTS DU POLYGONE
  12 : C        IPOLYG : NUMERO DES NOEUDS DU POLYGONE 
  13 : C        NCP   : NOMBRE DE POINT DU POLYGONE
  14 : C        FCRMIN: FONCTION RENVOYANT LA VALEUR DU CRITERE
  15 : C                FUNCTION REAL FCRMIN(P1,P2,P3) 
  16 : C                REAL*8 P1(*),P2(*),P3(*)
  17 : C                OU P1,P2,P3 SONT LES COORDONNEES DES POINTS 
  18 : C                DU TRIANGLE
  19 : C        ITVL  : TABLEAU DE TRAVAIL DE TAILLE NTIMAX
  20 : C        RTVL  : TABLEAU DE TRAVAIL DE TAILLE NTRMAX
  21 : C        
  22 : C        QTMIN : VALEUR MINIMUM DU CRITERE
  23 : C
  24 : C     EN SORTIE :
  25 : C        ITRPOL: TRIANGULATION RESULANTE
  26 : C                 ITRPOL((I-1)*3+1) PREMIER NOEUD DU TRIANGLE I
  27 : C                 ITRPOL((I-1)*3+2) DEUXIEME NOEUD DU TRIANGLE I
  28 : C                 ITRPOL((I-1)*3+3) TROISIEME NOEUD DU TRIANGLE I
  29 : C        QTMIN  : VALEUR MINIMUM DE FCRMIN SUR ITRPOL
  30 : C        iarr   : 0 SI TOUT EST OK
  31 : C                -1 SI QTMIN N'A PAS PU ETRE ATTEINT
  32 : C                -2 SI UN PROBLEME DE TAILLE MEMOIRE
  33 : C     *****************************************************************
  34 :       IMPLICIT INTEGER(I-N)
  35 :       REAL*8    X(*),QTMIN
  36 :       INTEGER IPOLYG(*),NCP,ITVL(*),NTIMAX,NTRMAX
  37 :       REAL*8    RTVL(*)
  38 :       INTEGER ITRPOL(*),iarr
  39 : C
  40 : C     NPMAX : LE NOMBRE MAXIMUM DE POLYGONES EMPILES
  41 : C     NCMAX : LE NOMBRE MAXIMUM DE COTE DU POLYGONE
  42 : C      PARAMETER (NPMAX = 1000,NCMAX = 20, IDIMC = 2)
  43 : C
  44 : C      REAL*8      FCRMIN
  45 : C      EXTERNAL  FCRMIN
  46 :       INTEGER   IND,ICARD,JT,IFD,IFG,IT,ITM,IPERE
  47 :       INTEGER   ITPOLY,ITRIA,ITRMIN,IQTRIA,IQMIN
  48 :       INTEGER   NPMAX,NCMAX
  49 : C
  50 :       NCMAX = NCP
  51 :       NPMAX = (NTIMAX - 3*(NCMAX-2)) / (2*(2*NCMAX+1))
  52 : C      WRITE (*,*) '---- LE RESPECT D ARETE ----'
  53 : C      WRITE (*,*) 'COTES DU POLYGONE NCP =',NCP
  54 : C      WRITE (*,*) 'PLACE DISPONIBLE NTIMAX =',NTIMAX
  55 : C      WRITE (*,*) 'TAILLE DE LA PILE NPMAX =',NPMAX
  56 : C
  57 :       NPMAX = MIN( (NTRMAX / 2),NPMAX )
  58 : C      WRITE (*,*) 'TAILLE DE LA PILE POUR LE RESPECT D ARETE =',NPMAX
  59 :       IF((NPMAX.LE.0).OR.(NTRMAX.LT.(2*NCMAX)))THEN
  60 :         iarr = -2
  61 :         GOTO 999
  62 :       ENDIF
  63 : C     --- ALLOCATION DE TOUS LES TABLEAUX ---
  64 :       IND   = 1
  65 :       ICARD = NPMAX + IND
  66 :       JT    = NPMAX + ICARD
  67 :       IFD   = NPMAX + JT
  68 :       IFG   = NPMAX + IFD
  69 :       IT    = NPMAX + IFG
  70 :       ITM   = NPMAX + IT
  71 :       IPERE = NPMAX + ITM
  72 :       ITPOLY= NPMAX + IPERE
  73 :       ITRIA = (NPMAX*NCMAX) + ITPOLY
  74 :       ITRMIN= ((NCMAX-2)*3) + ITRIA
  75 : C     ITRMIN((NCMAX-2)*3*NPMAX)      
  76 : C
  77 :       IQTRIA= 1
  78 :       IQMIN = NPMAX + IQTRIA
  79 : C     IQMIN(NPMAX)
  80 : C
  80 :       CALL TRPLSI(X,IPOLYG,NCP,
  81 :      >            ITVL(IND),ITVL(ICARD),ITVL(JT),ITVL(IFD),
  82 :      >            ITVL(IFG),ITVL(IT),ITVL(ITM),ITVL(IPERE),
  83 :      >            ITVL(ITPOLY),ITVL(ITRIA),
  84 :      >            ITVL(ITRMIN),
  85 :      >            RTVL(IQTRIA),RTVL(IQMIN),NPMAX,NCMAX,        
  86 : C     >            ITRPOL,FCRMIN,QTMIN,iarr)
  87 :      >            ITRPOL,QTMIN,iarr)
  88 : C
  89 :   999 END
  90 :  
  91 :  
  92 :