Télécharger courb2.eso

Retour à la liste

Numérotation des lignes :

  1. C COURB2 SOURCE BP208322 16/11/18 21:15:57 9177
  2. SUBROUTINE COURB2 (MCOURB,LIGNE)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * C O U R B 2
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CONSTRUCTION DE LA COURBE POLYNOMIALE.
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18. -INC CCGEOME
  19. -INC CCOPTIO
  20. -INC CCREEL
  21. -INC SMCOORD
  22. -INC SMELEME
  23. -INC TMCOURB
  24. *
  25. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  26. * -----------
  27. *
  28. * MCOURB (E) SEGMENT ACTIF.
  29. * +IDIM (E) VOIR LE COMMUN "COPTIO".
  30. * +IDCOUL (E) VOIR LE COMMUN "CGEOME".
  31. * +ILCOUR (E) VOIR LE COMMUN "CGEOME".
  32. * +KDEGRE (E) VOIR LE COMMUN "CGEOME".
  33. * +NBNNE (E) VOIR LE COMMUN "CGEOME".
  34. * +MCOORD (E) VOIR LE COMMUN "COPTIO".
  35. * +XPETIT (E) VOIR LE COMMUN "CREEL".
  36. * LIGNE (S) OBJET 'MAILLAGE'.
  37. *
  38. * VARIABLES:
  39. * ----------
  40. *
  41. * ABSC ABSCISSE CURVILIGNE OU PARAMETRIQUE COURANTE.
  42. * ABSCIS TABLE DES ABSCISSES CURVILIGNES OU PARAMETRIQUES, SELON
  43. * QUE L'ON A L'OPTION "REGULIER" OU NON.
  44. * ON N'Y MET PAS LES ABSCISSES DES EXTREMITES.
  45. * ALONG LONGUEUR APPROXIMATIVE DE LA COURBE POLYNOMIALE.
  46. * APROG "RAISON" DE LA PROGRESSION GEOMETRIQUE DES DENSITES
  47. * SUCCESSIVES LE LONG DE LA COURBE.
  48. * D9COU LARGEUR COURANTE DE MAILLE EN UNITES DE LONGUEUR OU
  49. * PARAMETRIQUES (SELON L'OPTION "REGULIER" OU NON).
  50. * MABCUR SEGMENT CREE DANS "COURB3" ET UTILISE DANS "COURB4".
  51. * PT0COU DERNIER POINT CREE AVANT CREATION DES POINTS INTERIEURS
  52. * DE LA COURBE.
  53. * PT9COU POINT COURANT DE LA COURBE.
  54. *
  55. SEGMENT,MABCUR
  56. REAL*8 ABCURV(NPDISC)
  57. ENDSEGMENT
  58. SEGMENT,MABSCI
  59. REAL*8 ABSCIS(NPOIN)
  60. ENDSEGMENT
  61. INTEGER PT0COU,PT9COU
  62. *
  63. * AUTEUR, DATE DE CREATION:
  64. * -------------------------
  65. *
  66. * PASCAL MANIGOT 8 SEPTEMBRE 1986
  67. * P.M. 6 MARS 1987: AMELIORATION DU CALCUL DE LA DENSITE.
  68. *
  69. * LANGAGE:
  70. * --------
  71. *
  72. * ESOPE + FORTRAN77
  73. *
  74. ************************************************************************
  75. *
  76. IF (D1COU.EQ.0. .OR. D2COU.EQ.0.) THEN
  77. CALL ERREUR(17)
  78. RETURN
  79. END IF
  80. *
  81. CALL COURB3 (MCOURB, ALONG,MABCUR)
  82. * CONTRAIREMENT AUX OPERATEURS "DROITE" ET CIE, ON ACCEPTE DE CREER
  83. * UNE COURBE POLYNOMIALE DE LONGUEUR NULLE. CECI EST PARTICULIERE-
  84. * MENT UTILE LORSQUE CETTE COURBE EST LE COTE D'UNE SURFACE
  85. * PARAMETREE.
  86. IF (ALONG .LT. XPETIT) ALONG = XPETIT
  87. *
  88. D1COU = D1COU / ALONG
  89. D2COU = D2COU / ALONG
  90. *
  91. * DETERMINATION DE LA RAISON DES DENSITES SUCCESSIVES (PROGRESSION
  92. * GEOMETRIQUE) ET DU NOMBRE D'ELEMENTS DE LA COURBE:
  93. DEN1=D1COU
  94. DEN2=D2COU
  95. CALL DECOUP(NLMCOU,DEN1,DEN2,APROG,NBELEM,DENI,DECA,ALONG)
  96. D1COU=DEN1
  97. D2COU=DEN2
  98. *
  99. NLMCOU = NBELEM
  100. *
  101. IF (REGCOU) THEN
  102. D1COU = D1COU * ALONG
  103. ELSE
  104. D1COU = D1COU * (U2COU-U1COU)
  105. END IF
  106. IF (ILCOUR .EQ. 0) GOTO 900
  107. ITYPLM = KDEGRE(ILCOUR)
  108. IF (ITYPLM .EQ. 0) GOTO 900
  109. NBNN = NBNNE(ITYPLM)
  110. IF (NBNN .NE. 2 .AND. NBNN .NE. 3) GOTO 900
  111. NBSOUS = 0
  112. NBREF = 0
  113. SEGINI,MELEME
  114. ITYPEL = ITYPLM
  115. DO 150 IB=1,NBELEM
  116. ICOLOR(IB) = IDCOUL
  117. 150 CONTINUE
  118. * END DO
  119. *
  120. NPOIN = NBELEM * (NBNN - 1) - 1
  121. SEGINI,MABSCI
  122. PT0COU = XCOOR(/1) / (IDIM+1)
  123. *
  124. PT9COU = PT0COU
  125. NUM(1,1) = PT1COU
  126. D9COU = D1COU
  127. IF (REGCOU) THEN
  128. ABSC = 0.
  129. ELSE
  130. ABSC = U1COU
  131. END IF
  132. *
  133. IF (NBNN .EQ. 2) THEN
  134. DO 300 IB=1,(NBELEM-1)
  135. PT9COU = PT9COU + 1
  136. NUM(2,IB) = PT9COU
  137. NUM(1,IB+1) = PT9COU
  138. D9COU = D9COU * APROG
  139. ABSC = ABSC + D9COU
  140. ABSCIS(PT9COU-PT0COU) = ABSC
  141. 300 CONTINUE
  142. * END DO
  143. NUM(2,NBELEM) = PT2COU
  144. ELSE
  145. * "NBNN" = 3
  146. DO 310 IB=1,(NBELEM-1)
  147. PT9COU = PT9COU + 1
  148. NUM(2,IB) = PT9COU
  149. D9COU = D9COU * APROG
  150. ABSCIS(PT9COU-PT0COU) = D9COU/2. + ABSC
  151. PT9COU = PT9COU + 1
  152. NUM(3,IB) = PT9COU
  153. NUM(1,IB+1) = PT9COU
  154. ABSC = ABSC + D9COU
  155. ABSCIS(PT9COU-PT0COU) = ABSC
  156. 310 CONTINUE
  157. * END DO
  158. PT9COU = PT9COU + 1
  159. NUM(2,NBELEM) = PT9COU
  160. D9COU = D9COU * APROG
  161. ABSCIS(PT9COU-PT0COU) = D9COU/2. + ABSC
  162. NUM(3,NBELEM) = PT2COU
  163. END IF
  164. *
  165. LIGNE = MELEME
  166. SEGDES,MELEME
  167. *
  168. IF (NPOIN .GT. 0) THEN
  169. IF (REGCOU) THEN
  170. CALL COURB4 (MCOURB,MABCUR,MABSCI,ALONG)
  171. ELSE
  172. CALL COURB5 (MCOURB,MABSCI)
  173. END IF
  174. END IF
  175. SEGSUP,MABSCI,MABCUR
  176. *
  177. RETURN
  178. *
  179. * TRAITEMENT DES ERREURS:
  180. *
  181. 900 CONTINUE
  182. * ERREUR SUR LE TYPE D'ELEMENT.
  183. CALL ERREUR (16)
  184. RETURN
  185. *
  186. END
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  

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