Télécharger courb4.eso

Retour à la liste

Numérotation des lignes :

  1. C COURB4 SOURCE BP208322 16/11/18 21:15:58 9177
  2. SUBROUTINE COURB4 (MCOURB,MABCUR,MABSCI,ALONG)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * C O U R B 4
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * DETERMINATION, A PARTIR D'UNE SUITE DISCRETE D'ABSCISSES
  14. * CURVILIGNES LE LONG DE LA COURBE POLYNOMIALE, DES COORDONNEES
  15. * DE POINTS A DES ABSCISSES CURVILIGNES DONNEES (PAR INTERPOLATION
  16. * LINEAIRE).
  17. *
  18. * MODULES UTILISES:
  19. * -----------------
  20. *
  21. -INC CCOPTIO
  22. -INC CCGEOME
  23. -INC CCREEL
  24. -INC SMCOORD
  25. -INC TMCOURB
  26. *
  27. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  28. * -----------
  29. *
  30. * MCOURB (E) SEGMENT ACTIF.
  31. * (S) ETENDU EN SORTIE (TABLEAU "UCOU" REMPLI).
  32. * MABCUR (E) SEGMENT ACTIF DEFINI DANS LE S-P "COURB3".
  33. * MABSCI (E) SEGMENT ACTIF DEFINI DANS LE S-P "COURB2".
  34. * ICI, IL S'AGIT D'ABSCISSES CURVILIGNES.
  35. * ALONG (E) LONGUEUR APPROXIMATIVE DE LA COURBE POLYNOMIALE.
  36. * +IDIM (E) VOIR LE COMMUN "COPTIO".
  37. * +ILCOUR (E) VOIR LE COMMUN "CGEOME".
  38. * +XPETIT (E) VOIR LE COMMUN "CREEL".
  39. * +MCOORD (E) SEGMENT ACTIF.
  40. * (S) COMPLETE EN SORTIE.
  41. *
  42. SEGMENT,MABCUR
  43. REAL*8 ABCURV(NPDISC)
  44. ENDSEGMENT
  45. SEGMENT,MABSCI
  46. REAL*8 ABSCIS(NPOIN)
  47. ENDSEGMENT
  48. *
  49. * VARIABLES:
  50. * ----------
  51. *
  52. * COFDEN = FACTEUR CORRECTIF DE LA DENSITE LOCALE CALCULEE, SELON
  53. * LE TYPE D'ELEMENT (SEG2 OU SEG3).
  54. *
  55. REAL*8 COFDEN
  56. REAL*8 U
  57. *
  58. * FONCTIONS:
  59. * ----------
  60. *
  61. REAL*8 POLYNO
  62. *
  63. * REMARQUES:
  64. * ----------
  65. *
  66. * CE SOUS-PROGRAMME N'EST PAS PREVU POUR FONCTIONNER AVEC UN NOMBRE
  67. * DE POINTS NUL.
  68. *
  69. * AUTEUR, DATE DE CREATION:
  70. * -------------------------
  71. *
  72. * PASCAL MANIGOT 10 SEPTEMBRE 1986
  73. * P.M. 24/02/87 : REMODELAGE, AVEC UN NOUVEAU SEGMENT "MCOURB".
  74. *
  75. * LANGAGE:
  76. * --------
  77. *
  78. * ESOPE + FORTRAN77
  79. *
  80. ************************************************************************
  81. *
  82. NPOIN = ABSCIS(/1)
  83. NPDISC = ABCURV(/1)
  84. DU = (U2COU - U1COU) / REAL(NPDISC-1)
  85. *
  86. IF (ILCOUR .EQ. 2) THEN
  87. COFDEN = 0.5
  88. ELSE
  89. * "ILCOUR" EST SUPPOSE VALOIR 3.
  90. COFDEN = 1.
  91. END IF
  92. ABSC1 = 0.
  93. ABSC2 = ABSCIS(1)
  94. *
  95. LONG = NPOIN
  96. SEGADJ,MCOURB
  97. IDIMP1 = IDIM + 1
  98. NBPTA=XCOOR(/1)/IDIMP1
  99. NBPTS=NBPTA+NPOIN
  100. SEGADJ MCOORD
  101. MCOFCO = ICOFCO
  102. SEGACT,MCOFCO
  103. *
  104. DO 200 IB=1,NPOIN
  105. *
  106. * POUR UN POINT A ETUDIER, DETERMINATION DE 2 POINTS DE
  107. * COORDONNEES PARAMETRIQUES CONNUES ET L'ENCADRANT SUR LA COURBE.
  108. *
  109. ABSC0 = ABSC1
  110. ABSC1 = ABSC2
  111. IF (IB .EQ. NPOIN) THEN
  112. ABSC2 = ALONG
  113. ELSE
  114. ABSC2 = ABSCIS(IB+1)
  115. END IF
  116. *
  117. DO 210 IB2=2,NPDISC
  118. IF (ABSC1 .LE. ABCURV(IB2)) THEN
  119. * --> SORTIE DE BOUCLE
  120. GOTO 212
  121. END IF
  122. 210 CONTINUE
  123. * END DO
  124. IB2 = NPDISC
  125. *+* VAUDRAIT-IL MIEUX UN MESSAGE D'ERREUR ?
  126. 212 CONTINUE
  127. *
  128. * CALCUL DE LA COORDONNEE INTRINSEQUE PAR INTERPOLATION LINEAIRE
  129. *
  130. COFDIV = ABCURV(IB2) - ABCURV(IB2-1)
  131. IF (ABS(COFDIV) .LE. XPETIT) THEN
  132. * LA PORTION DE COURBE EST DE LONGUEUR NULLE. L'ABSCISSE
  133. * CURVILIGNE RESTE PRATIQUEMENT CONSTANTE.
  134. COF = 0.
  135. ELSE
  136. COF = (ABSC1 - ABCURV(IB2-1)) / COFDIV
  137. END IF
  138. U = U1COU + DU*REAL(IB2-2) + DU*COF
  139. *
  140. * CALCUL DES COORDONNEES.
  141. *
  142. XCOOR(NBPTA*IDIMP1+1) = POLYNO (COFCOU(1,1),ND1COU,1,U)
  143. XCOOR(NBPTA*IDIMP1+2) = POLYNO (COFCOU(1,2),ND1COU,1,U)
  144. IF (IDIM .EQ. 3)
  145. # XCOOR(NBPTA*IDIMP1+3) = POLYNO (COFCOU(1,3),ND1COU,1,U)
  146. XCOOR(NBPTA*IDIMP1+IDIMP1) = (ABSC2 - ABSC0) * COFDEN
  147. NBPTA=NBPTA+1
  148. *
  149. *+* ON POURRAIT ENVISAGER UN PETIT SCHEMA ITERATIF POUR QUE
  150. *+* L'INTERPOLATION SOIT LINEAIRE SUIVANT L'ABSCISSE CURVILIGNE.
  151. *
  152. UCOU(IB) = U
  153. *
  154. 200 CONTINUE
  155. * END DO
  156. *
  157. SEGDES,MCOFCO
  158. *
  159. END
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  

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