Télécharger la plaquette Cast3M


fr en

Télécharger trpls2.eso

Retour à la liste

Numérotation des lignes : 

trpls2

  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
  81.       CALL TRPLSI(X,IPOLYG,NCP,
  82.      >            ITVL(IND),ITVL(ICARD),ITVL(JT),ITVL(IFD),
  83.      >            ITVL(IFG),ITVL(IT),ITVL(ITM),ITVL(IPERE),
  84.      >            ITVL(ITPOLY),ITVL(ITRIA),
  85.      >            ITVL(ITRMIN),
  86.      >            RTVL(IQTRIA),RTVL(IQMIN),NPMAX,NCMAX,
  87. C     >            ITRPOL,FCRMIN,QTMIN,iarr)
  88.      >            ITRPOL,QTMIN,iarr)
  89. C
  90.   999 END
  91.  
  92.  
  93.  
  94.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales