Télécharger rf2rar.eso

Retour à la liste

Numérotation des lignes :

  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
  49. CALL TRITSE(NN,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  50. > NOETRI,NBE,COORD,ITVL(INTER),NINTER)
  51. C WRITE(6,*) 'SORTIE TRISTE ninter = ',NINTER
  52. NBENEW = NINTER
  53. IF( NINTER .EQ. 0 ) GO TO 999
  54. C ---- BUG_14 O.STAB 28.03.97 ----
  55. IF( NINTER .LT. 0 )THEN
  56. iarr = NINTER
  57. GO TO 999
  58. ENDIF
  59. C ====================
  60. C ------- 2.FORCAGE OPTIMUM ----------
  61. C ====================
  62. ITRAV = NINTER + INTER
  63. CALL RF2FAR(NN,ITVL(INTER),NINTER,
  64. > ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  65. > NOETRI,NBE,COORD,ITVL(ITRAV),
  66. > (NTIMAX-NINTER),RTVL,NTRMAX,iarr)
  67. C
  68. C WRITE(6,*) 'SORTIE RF2FAR iarr = ',iarr
  69. 999 END
  70.  
  71.  
  72.  
  73.  

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