Télécharger courbe.eso

Retour à la liste

Numérotation des lignes :

  1. C COURBE SOURCE CHAT 05/01/12 22:25:31 5004
  2. SUBROUTINE COURBE
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * C O U R B E
  8. * -----------
  9. *
  10. * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "COURBE"
  11. *
  12. * FONCTION:
  13. * ---------
  14. *
  15. * CREATION D'UNE COURBE POLYNOMIALE, C'EST-A-DIRE DONT LES POINTS
  16. * "P" VERIFIENT UNE EQUATION:
  17. *
  18. * 2 3
  19. * P(U) = P0 + U.P1 + U .P2 + U .P3 + ...
  20. *
  21. * PHRASE D'APPEL (EN GIBIANE):
  22. * ----------------------------
  23. *
  24. * LILI = COURBE (N) (DINI DENS1) (DFIN DENS2) (PINI OB1) (PFIN OB2)
  25. * P0 P1 (P2 (P3 ...) ) (PARAMETRE U1 U2) (REGULIER) ;
  26. *
  27. * OPERANDES ET RESULTATS:
  28. * -----------------------
  29. *
  30. * LILI 'MAILLAGE' MAILLAGE RESULTANT DE L'OPERATION. OUTRE LA
  31. * COURBE POLYNOMIALE NOUVELLEMENT CREEE, CE
  32. * MAILLAGE COMPRENDRA "OB1" ET/OU "OB2", QUE
  33. * CE SOIENT DES 'POINTS' OU DES 'MAILLAGE'.
  34. * N 'ENTIER ' NOMBRE D'ELEMENTS GEOMETRIQUES DEMANDE.
  35. * > 0 : LONGUEURS EGALES DES ELEMENTS.
  36. * < 0 : LONGUEURS DES ELEMENTS FONCTIONS DES
  37. * DENSITES DES EXTREMITES DE LA COURBE.
  38. * DINI 'MOT '
  39. * DENS1 'FLOTTANT' DENSITE DEMANDEE POUR LE 1ER ELEMENT.
  40. * DFIN 'MOT '
  41. * DENS2 'FLOTTANT' DENSITE DEMANDEE POUR LE DERNIER ELEMENT.
  42. * PINI 'MOT '
  43. * OB1 'POINT ' POINT INITIAL DE LA COURBE: SERA
  44. * EFFECTIVEMENT PRIS COMME TEL SI SES
  45. * COORDONNEES S'OBTIENNENT POUR LA VALEUR "U1"
  46. * (VOIR DEFINITION PLUS LOIN).
  47. * OU 'MAILLAGE' LE POINT FINAL DE CET OBJET "OB1" (FORCEMENT
  48. * UNE LIGNE) SERA LE POINT INITIAL DE LA
  49. * COURBE (AVEC LES MEMES RESERVES QUE
  50. * CI-DESSUS) ET "LILI" CONTIENDRA "OB1".
  51. * PFIN 'MOT '
  52. * OB2 'POINT ' POINT FINAL DE LA COURBE: SERA EFFECTIVEMENT
  53. * PRIS COMME TEL SI SES COORDONNEES
  54. * S'OBTIENNENT POUR LA VALEUR "U2" (VOIR
  55. * DEFINITION PLUS LOIN).
  56. * OU 'MAILLAGE' LE POINT INITIAL DE CET OBJET "OB2"
  57. * (FORCEMENT UNE LIGNE) SERA LE POINT FINAL
  58. * DE LA COURBE (AVEC LES MEMES RESERVES QUE
  59. * CI-DESSUS) ET "LILI" CONTIENDRA "OB2".
  60. * P0, P1, 'POINT ' POINTS DE LA REPRESENTATION POLYNOMIALE DE
  61. * P2, ... LA COURBE.
  62. * CES POINTS NE FONT PAS PARTIE DE LA COURBE.
  63. * "P0" ET "P1" SONT OBLIGATOIRES.
  64. * PARAMETR 'MOT '
  65. * U1, U2 'FLOTTANT' BORNES DU PARAMETRE "U" DU POLYNOME DE LA
  66. * COURBE.
  67. * = (0,1) PAR DEFAUT.
  68. * REGULIER 'MOT ' INDIQUE QUE LA COURBE DEVRA ETRE SUBDIVISEE
  69. * EN ELEMENTS DONT LES LONGUEURS SERONT
  70. * ETABLIES SELON L'ABSCISSE CURVILIGNE ET NON
  71. * PAS SELON LE PARAMETRE "U".
  72. *
  73. * MODULES UTILISES:
  74. * -----------------
  75. *
  76. -INC CCOPTIO
  77. -INC CCREEL
  78. -INC SMCOORD
  79. -INC TMCOURB
  80. *
  81. * VARIABLES:
  82. * ----------
  83. *
  84. * BIDSP, BIDDP = VARIABLES UTILISEES POUR RESOUDRE DES PROBLEMES DE
  85. * LECTURES DE REELS, TANTOT EN S.P., TANTOT EN D.P.,
  86. * ET, PEUT-ETRE, BIENTOT EN ON-NE-SAIT-QUOI.
  87. *
  88. SEGMENT,MTEMP
  89. INTEGER ITEMP(2)
  90. ENDSEGMENT
  91. *
  92. * CONSTANTES:
  93. * -----------
  94. *
  95. * MOTCLE LISTE DES MOTS-CLES RECONNUS.
  96. *
  97. INTEGER LMOTCL
  98. PARAMETER (LMOTCL = 6)
  99. CHARACTER*4 MOTCLE(LMOTCL)
  100. *
  101. * AUTEUR, DATE DE CREATION:
  102. * -------------------------
  103. *
  104. * PASCAL MANIGOT 11 SEPTEMBRE 1986
  105. * P.M. 25/02/87 : REPRISE.
  106. *
  107. * LANGAGE:
  108. * --------
  109. *
  110. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  111. *
  112. ************************************************************************
  113. *
  114. REAL*8 RBID(1)
  115. DIMENSION IBID(1)
  116. DATA MOTCLE/'DINI','DFIN','PINI','PFIN','PARA','REGU'/
  117. *
  118. LONG = 0
  119. SEGINI,MCOURB
  120. *
  121. * -- LECTURE DES PARAMETRES PARTICULIERS --
  122. *
  123. * FACTEUR DE DECOUPAGE:
  124. CALL LIRENT (I,0,IRETOU)
  125. IF (IRETOU .EQ. 1) THEN
  126. NLMCOU = I
  127. ELSE
  128. NLMCOU = 0
  129. END IF
  130. *
  131. U1COU = 0.D0
  132. U2COU = 1.D0
  133. D1COU = 0.
  134. D2COU = 0.
  135. PT1COU = 0
  136. LI1COU = 0
  137. PT2COU = 0
  138. LI2COU = 0
  139. REGCOU = .FALSE.
  140. *
  141. * DO
  142. 205 CONTINUE
  143. *
  144. IRETOU = 0
  145. CALL LIRMOT (MOTCLE,LMOTCL,IRETOU,0)
  146. IF (IRETOU .LE. 0) THEN
  147. * --> SORTIE DE BOUCLE
  148. GOTO 206
  149. END IF
  150. *
  151. GOTO (101,102,103,104,105,106) IRETOU
  152. 101 CONTINUE
  153. CALL LIRE04 (XPETIT,BIDDP,0,1,IRETOU)
  154. IF (IERR .NE. 0) RETURN
  155. D1COU = BIDDP
  156. GOTO 200
  157. 102 CONTINUE
  158. CALL LIRE04 (XPETIT,BIDDP,0,1,IRETOU)
  159. IF (IERR .NE. 0) RETURN
  160. D2COU = BIDDP
  161. GOTO 200
  162. 103 CONTINUE
  163. * IL FAUT ESSAYER DE LIRE UN "MAILLAGE" AVANT UN "POINT" POUR
  164. * NE PAS LIRE PAR ERREUR LES POINTS-COEFFICIENTS DU POLYNOME.
  165. IRETOU = 0
  166. CALL LIROBJ ('MAILLAGE',I,0,IRETOU)
  167. IF (IRETOU .EQ. 1) THEN
  168. LI1COU = I
  169. ELSE
  170. CALL LIROBJ ('POINT',I,1,IRETOU)
  171. IF (IERR .NE. 0) RETURN
  172. PT1COU = I
  173. END IF
  174. GOTO 200
  175. 104 CONTINUE
  176. IRETOU = 0
  177. CALL LIROBJ ('MAILLAGE',I,0,IRETOU)
  178. IF (IRETOU .EQ. 1) THEN
  179. LI2COU = I
  180. ELSE
  181. CALL LIROBJ ('POINT',I,1,IRETOU)
  182. IF (IERR .NE. 0) RETURN
  183. PT2COU = I
  184. END IF
  185. GOTO 200
  186. 105 CONTINUE
  187. CALL LIRREE (BIDSP,1,IRETOU)
  188. IF (IERR .NE. 0) RETURN
  189. U1COU = BIDSP
  190. CALL LIRREE (BIDSP,1,IRETOU)
  191. IF (IERR .NE. 0) RETURN
  192. U2COU = BIDSP
  193. * RQ: AUCUNE RELATION D'ORDRE ENTRE "U1COU" ET "U2COU" POUR
  194. * NE PAS IMPOSER, PAR EXEMPLE, AU POINT INITIAL DE
  195. * CORRESPONDRE AU PLUS PETIT PARAMETRE.
  196. GOTO 200
  197. 106 CONTINUE
  198. REGCOU = .TRUE.
  199. GOTO 200
  200. 200 CONTINUE
  201. *
  202. GOTO 205
  203. * END DO
  204. 206 CONTINUE
  205. *
  206. * -- LECTURE DES POINTS DU POLYNOME --
  207. *
  208. SEGINI,MTEMP
  209. CALL LIROBJ ('POINT',IP,1,IRETOU)
  210. IF (IERR .NE. 0) RETURN
  211. ITEMP(1) = IP
  212. CALL LIROBJ ('POINT',IP,1,IRETOU)
  213. IF (IERR .NE. 0) RETURN
  214. ITEMP(2) = IP
  215. * DO
  216. 305 CONTINUE
  217. CALL LIROBJ ('POINT',IP,0,IRETOU)
  218. IF (IRETOU .EQ. 1) THEN
  219. ITEMP(**) = IP
  220. ELSE
  221. * --> SORTIE DE BOUCLE
  222. GOTO 306
  223. END IF
  224. GOTO 305
  225. * END DO
  226. 306 CONTINUE
  227. ND1COU = ITEMP(/1)
  228. *
  229. * CREATION DES POLYNOMES REELS:
  230. N = ND1COU
  231. SEGINI,MCOFCO
  232. ICOFCO = MCOFCO
  233. SEGACT,MCOORD
  234. IF (IDIM .EQ. 3) THEN
  235. CALL DCOMP1(ITEMP,N,XCOOR,COFCOU(1,1),COFCOU(1,2),COFCOU(1,3))
  236. ELSE
  237. CALL DCOMP1(ITEMP,N,XCOOR,COFCOU(1,1),COFCOU(1,2),RBID)
  238. END IF
  239. SEGSUP,MTEMP
  240. SEGDES,MCOFCO
  241. *
  242. CALL COURB1 (MCOURB, LIGNE)
  243. IF (IERR .NE. 0) RETURN
  244. MCOFCO = ICOFCO
  245. SEGSUP,MCOFCO
  246. SEGSUP,MCOURB
  247. *
  248. CALL ECROBJ ('MAILLAGE',LIGNE)
  249. *
  250. END
  251.  
  252.  
  253.  
  254.  

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