Télécharger courb3.eso

Retour à la liste

Numérotation des lignes :

  1. C COURB3 SOURCE PV 07/11/23 21:16:08 5978
  2. SUBROUTINE COURB3 (MCOURB,ALONG,MABCUR)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * C O U R B 3
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CREATION D'ABSCISSES CURVILIGNES EN UN NOMBRE DISCRET DE POINTS
  14. * DE LA COURBE POLYNOMIALE, ET DE SA LONGUEUR TOTALE APPROXIMATIVE.
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19. -INC CCOPTIO
  20. -INC SMCOORD
  21. -INC TMCOURB
  22. *
  23. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  24. * -----------
  25. *
  26. * MCOURB (E) SEGMENT ACTIF.
  27. * +IDIM (E) VOIR LE COMMUN "COPTIO".
  28. * +MCOORD (E) SEGMENT ACTIF.
  29. * ALONG (S) LONGUEUR APPROXIMATIVE DE LA COURBE POLYNOMIALE.
  30. * MABCUR (S) POINTEUR DE SEGMENT CONTENANT LES ABSCISSES
  31. * CURVILIGNES EN UN NOMBRE FINI DE POINTS DE LA COURBE
  32. * (DONT LES POINTS EXTREMITES).
  33. * SEGMENT LAISSE DANS L'ETAT ACTIF.
  34. *
  35. SEGMENT,MABCUR
  36. REAL*8 ABCURV(NPDISC)
  37. ENDSEGMENT
  38. *
  39. * VARIABLES:
  40. * ----------
  41. *
  42. REAL*8 U
  43. *
  44. * CONSTANTES:
  45. * -----------
  46. *
  47. * NPDISC NOMBRE DE POINTS DE DISCRETISATION DE LA COURBE.
  48. *
  49. INTEGER NPDISC,NPDIS1
  50. PARAMETER (NPDISC = 101, NPDIS1 = NPDISC-1)
  51. *
  52. * FONCTIONS:
  53. * ----------
  54. *
  55. REAL*8 POLYNO
  56. *
  57. * REMARQUES:
  58. * ----------
  59. *
  60. * LE REMPLISSAGE DE "ABCURV" NE S'IMPOSE QUE POUR L'OPTION
  61. * "REGULIER" DE L'OPERATEUR "COURBE".
  62. *
  63. * AUTEUR, DATE DE CREATION:
  64. * -------------------------
  65. *
  66. * PASCAL MANIGOT 10 SEPTEMBRE 1986
  67. * P.M. 24/02/87 : REMODELAGE, AVEC UN NOUVEAU SEGMENT "MCOURB".
  68. *
  69. * LANGAGE:
  70. * --------
  71. *
  72. * ESOPE + FORTRAN77 + EXTENSION: DECLARATION "REAL*8".
  73. *
  74. ************************************************************************
  75. *
  76. SEGINI,MABCUR
  77. ABCURV(1) = 0.
  78. U = U1COU
  79. DU = (U2COU - U1COU) / REAL(NPDIS1)
  80. IP = (PT1COU - 1) * (IDIM + 1)
  81. X3COU = XCOOR(IP+1)
  82. Y3COU = XCOOR(IP+2)
  83. Z3COU = XCOOR(IP+3)
  84. IP = (PT2COU - 1) * (IDIM + 1)
  85. X2COU = XCOOR(IP+1)
  86. Y2COU = XCOOR(IP+2)
  87. Z2COU = XCOOR(IP+3)
  88. *
  89. MCOFCO = ICOFCO
  90. SEGACT,MCOFCO
  91. IF (IDIM .EQ. 3) THEN
  92. DO 100 IB=2,NPDIS1
  93. U = U + DU
  94. X4COU = POLYNO (COFCOU(1,1),ND1COU,1,U)
  95. Y4COU = POLYNO (COFCOU(1,2),ND1COU,1,U)
  96. Z4COU = POLYNO (COFCOU(1,3),ND1COU,1,U)
  97. ABCURV(IB) = ABCURV(IB-1) + SQRT((X4COU-X3COU)**2
  98. & + (Y4COU-Y3COU)**2 + (Z4COU-Z3COU)**2)
  99. X3COU = X4COU
  100. Y3COU = Y4COU
  101. Z3COU = Z4COU
  102. 100 CONTINUE
  103. * END DO
  104. ALONG = ABCURV(NPDIS1) + SQRT((X2COU-X3COU)**2
  105. & + (Y2COU-Y3COU)**2 + (Z2COU-Z3COU)**2)
  106. ELSE
  107. DO 110 IB=2,NPDIS1
  108. U = U + DU
  109. X4COU = POLYNO (COFCOU(1,1),ND1COU,1,U)
  110. Y4COU = POLYNO (COFCOU(1,2),ND1COU,1,U)
  111. ABCURV(IB) = ABCURV(IB-1) + SQRT((X4COU-X3COU)**2
  112. & + (Y4COU-Y3COU)**2)
  113. X3COU = X4COU
  114. Y3COU = Y4COU
  115. 110 CONTINUE
  116. * END DO
  117. ALONG = ABCURV(NPDIS1) + SQRT((X2COU-X3COU)**2
  118. & + (Y2COU-Y3COU)**2)
  119. END IF
  120. ABCURV(NPDISC) = ALONG
  121. *
  122. SEGDES,MCOFCO
  123. *
  124. END
  125.  
  126.  
  127.  

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