Télécharger courb5.eso

Retour à la liste

Numérotation des lignes :

  1. C COURB5 SOURCE BP208322 16/11/18 21:15:59 9177
  2. SUBROUTINE COURB5 (MCOURB,MABSCI)
  3. ************************************************************************
  4. *
  5. * C O U R B 5
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * CALCUL DES COORDONNEES DES NOUVEAUX POINTS CREES POUR LA COURBE
  12. * POLYNOMIALE, COURBE POUR LAQUELLE IL N'AVAIT PAS ETE DEMANDE DE
  13. * REGULARITE SELON L'ABSCISSE CURVILIGNE.
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT real*8 (a-h,o-z)
  20. -INC CCOPTIO
  21. -INC CCGEOME
  22. -INC SMCOORD
  23. -INC TMCOURB
  24. *
  25. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  26. * -----------
  27. *
  28. * MCOURB (E) SEGMENT ACTIF.
  29. * (S) ETENDU EN SORTIE (TABLEAU "UCOU" REMPLI).
  30. * MABSCI (E) SEGMENT ACTIF, DEFINI DANS LE S-P "COURB2".
  31. * ICI, IL S'AGIT D'ABSCISSES PARAMETRIQUES.
  32. * +IDIM (E) VOIR LE COMMUN "COPTIO".
  33. * +ILCOUR (E) VOIR LE COMMUN "CGEOME".
  34. * +MCOORD (E) SEGMENT ACTIF.
  35. * (S) ETENDU EN SORTIE.
  36. *
  37. SEGMENT,MABSCI
  38. REAL*8 ABSCIS(NPOIN)
  39. ENDSEGMENT
  40. *
  41. * VARIABLES:
  42. * ----------
  43. *
  44. * D1 = DISTANCE DU POINT COURANT AVEC LE POINT PRECEDENT.
  45. * D3 = DISTANCE DU POINT COURANT AVEC LE POINT SUIVANT.
  46. * NPOLD = NOMBRE DE POINTS AVANT AJOUT.
  47. * NPOIN = NOMBRE DE POINTS A AJOUTER.
  48. * U2 = PARAMETRE DU POINT COURANT.
  49. * UINF, USUP = BORNES ENCADRANT LE PARAMETRE DU POINT-MILIEU
  50. * COURANT.
  51. *
  52. * EN GENERAL, INDICE 1 POUR POINT PRECEDENT, INDICE 2 POUR POINT
  53. * COURANT ET INDICE 3 POUR POINT SUIVANT.
  54. *
  55. INTEGER NPOLD,NPOIN
  56. REAL*8 USUP,UINF,D1,D3
  57. REAL*8 U2
  58. *
  59. * FONCTIONS:
  60. * ----------
  61. *
  62. REAL*8 POLYNO
  63. *
  64. * REMARQUES:
  65. * ----------
  66. *
  67. * CE SOUS-PROGRAMME N'EST PAS PREVU POUR FONCTIONNER AVEC UN NOMBRE
  68. * DE POINTS NUL.
  69. *
  70. * AUTEUR, DATE DE CREATION:
  71. * -------------------------
  72. *
  73. * PASCAL MANIGOT 10 SEPTEMBRE 1986
  74. * P.M. 24/02/87 : REMODELAGE, AVEC UN NOUVEAU SEGMENT "MCOURB".
  75. *
  76. * LANGAGE:
  77. * --------
  78. *
  79. * ESOPE77 FORTRAN77 + EXTENSION: DECLARATION "REAL*8".
  80. *
  81. ************************************************************************
  82. *
  83. NPOIN = ABSCIS(/1)
  84. IDIMP1 = IDIM + 1
  85. NPOLD = XCOOR(/1) / IDIMP1
  86. *
  87. * DETERMINATION DES COORDONNEES DES NOUVEAUX POINTS.
  88. *
  89. LONG = NPOIN
  90. SEGADJ,MCOURB
  91. NBPTA = NPOLD
  92. NBPTS=NBPTA+NPOIN
  93. SEGADJ MCOORD
  94. MCOFCO = ICOFCO
  95. SEGACT,MCOFCO
  96. *
  97. DO 300 IB=1,NPOIN
  98. U2 = ABSCIS(IB)
  99. UCOU(IB) = U2
  100. XCOOR(NBPTA*IDIMP1+1) = POLYNO (COFCOU(1,1),ND1COU,1,U2)
  101. XCOOR(NBPTA*IDIMP1+2) = POLYNO (COFCOU(1,2),ND1COU,1,U2)
  102. IF (IDIM .EQ. 3)
  103. # XCOOR(NBPTA*IDIMP1+3) = POLYNO (COFCOU(1,3),ND1COU,1,U2)
  104. NBPTA=NBPTA+1
  105. 300 CONTINUE
  106. * END DO
  107. *
  108. IF (ILCOUR .EQ. 3) THEN
  109. *
  110. * AJUSTEMENT DE LA PLACE DES POINTS-MILIEUX POUR QU'ILS SOIENT
  111. * BIEN ... AU MILIEU DES ELEMENTS.
  112. * LES POINTS-MILIEUX SONT AUX PLACES 1, 3, ... , NPOIN (AU
  113. * COEFFICIENT MULTIPLICATIF IDIM+1 PRES) DANS LA PARTIE AJOUTEE
  114. * DE "XCOOR".
  115. * ON EN PROFITE POUR INSCRIRE LA DENSITE DES POINTS-MILIEUX.
  116. *
  117. I3 = (PT1COU - 1) * IDIMP1
  118. X3 = XCOOR(I3+1)
  119. Y3 = XCOOR(I3+2)
  120. IF (IDIM .EQ. 3) Z3 = XCOOR(I3+3)
  121. U3 = U1COU
  122. *
  123. DO 310 IB=1,NPOIN,2
  124. *
  125. U1 = U3
  126. X1 = X3
  127. Y1 = Y3
  128. I2 = (IB + NPOLD - 1) * IDIMP1
  129. U2 = ABSCIS(IB)
  130. X2 = XCOOR(I2+1)
  131. Y2 = XCOOR(I2+2)
  132. IF (IB .EQ. NPOIN) THEN
  133. I3 = (PT2COU - 1) * IDIMP1
  134. U3 = U2COU
  135. ELSE
  136. I3 = (IB + NPOLD) * IDIMP1
  137. U3 = ABSCIS(IB+1)
  138. END IF
  139. X3 = XCOOR(I3+1)
  140. Y3 = XCOOR(I3+2)
  141. IF (IDIM .EQ. 3) THEN
  142. Z1 = Z3
  143. Z2 = XCOOR(I2+3)
  144. Z3 = XCOOR(I3+3)
  145. D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 + (Z2-Z1)**2 )
  146. D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 + (Z2-Z3)**2 )
  147. ELSE
  148. D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
  149. D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 )
  150. END IF
  151. UINF = U1
  152. USUP = U3
  153. *
  154. NFOIS = 0
  155. 315 IF (ABS(D3-D1) .GT. (0.1*(D1+D3)) .AND. NFOIS.LT.5) THEN
  156. *
  157. IF (D1 .GT. D3) THEN
  158. USUP = U2
  159. ELSE
  160. UINF = U2
  161. END IF
  162. U2 = (UINF + USUP) / 2.
  163. X2 = POLYNO (COFCOU(1,1),ND1COU,1,U2)
  164. Y2 = POLYNO (COFCOU(1,2),ND1COU,1,U2)
  165. IF (IDIM .EQ. 3) THEN
  166. Z2 = POLYNO (COFCOU(1,3),ND1COU,1,U2)
  167. D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 + (Z2-Z1)**2 )
  168. D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 + (Z2-Z3)**2 )
  169. ELSE
  170. D1 = SQRT( (X2-X1)**2 + (Y2-Y1)**2 )
  171. D3 = SQRT( (X2-X3)**2 + (Y2-Y3)**2 )
  172. END IF
  173. NFOIS = NFOIS + 1
  174. *
  175. GOTO 315
  176. END IF
  177. *
  178. IF (NFOIS .GT. 0) THEN
  179. * RECTIFICATION DES COORDONNEES ET DU PARAMETRE:
  180. XCOOR(I2+1) = X2
  181. XCOOR(I2+2) = Y2
  182. IF (IDIM .EQ. 3) XCOOR(I2+3) = Z2
  183. UCOU(IB) = U2
  184. END IF
  185. XCOOR(I2+IDIMP1) = D1 + D3
  186. * CI-DESSUS, ON NE DIVISE PAS PAR 2 CAR, POUR UN "SEG3", IL NE
  187. * FAUT PAS CONFONDRE LARGEUR DE MAILLE ET DISTANCE ENTRE 2
  188. * POINTS.
  189. IF (IIMPI .EQ. 342) WRITE (IOIMP,*) 'NFOIS = ',NFOIS
  190. *
  191. 310 CONTINUE
  192. * END DO
  193. *
  194. * LA BOUCLE 330 VA TRAITER LES POINTS NOUVEAUX N. 2, 4, 6, ...
  195. IB1 = 2
  196. IB2 = NPOIN - 1
  197. IB3 = 2
  198. *
  199. ELSE
  200. * ILCOUR = 2
  201. *
  202. * LA BOUCLE 330 VA TRAITER TOUS LES POINTS NOUVEAUX.
  203. IB1 = 1
  204. IB2 = NPOIN
  205. IB3 = 1
  206. *
  207. END IF
  208. *
  209. SEGDES,MCOFCO
  210. *
  211. * DETERMINATION DES DENSITES DES EXTREMITES DES SEGMENTS:
  212. *
  213. IF (IB1 .LE. IB2) THEN
  214. I2 = (PT1COU - 1) * IDIMP1
  215. I3 = (IB1 + NPOLD - 1) * IDIMP1
  216. D3 = (XCOOR(I3+1) - XCOOR(I2+1) ) ** 2
  217. & + (XCOOR(I3+2) - XCOOR(I2+2) ) ** 2
  218. IF (IDIM .EQ. 3) D3 = D3 + (XCOOR(I3+3) - XCOOR(I2+3) )**2
  219. D3 = SQRT(D3)
  220. DO 330 IB=IB1,IB2,IB3
  221. I2 = I3
  222. IF (IB .EQ. IB2) THEN
  223. I3 = (PT2COU - 1) * IDIMP1
  224. ELSE
  225. I3 = (IB + NPOLD - 1 + IB3) * IDIMP1
  226. END IF
  227. D1 = D3
  228. D3 = (XCOOR(I3+1) - XCOOR(I2+1) ) ** 2
  229. & + (XCOOR(I3+2) - XCOOR(I2+2) ) ** 2
  230. IF (IDIM .EQ. 3) D3 = D3 + (XCOOR(I3+3) - XCOOR(I2+3) )**2
  231. D3 = SQRT(D3)
  232. XCOOR(I2+IDIMP1) = (D1 + D3) / 2.
  233. 330 CONTINUE
  234. * END DO
  235. END IF
  236. *
  237. END
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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