Télécharger @pomi.procedur

Retour à la liste

Numérotation des lignes :

  1. * @POMI PROCEDUR JC220346 14/12/09 21:15:01 8314
  2. *-----------------------------------------------------------
  3. ****** PROCEDURE @POMI ******
  4. *-----------------------------------------------------------
  5. *
  6. * CETTE PROCEDURE A ETE MISE GRACIEUSEMENT
  7. * A DISPOSITION DE LA COMMUNAUTE CASTEM2000
  8. * PAR DELERUYELLE Fr. (SOCOTEC-INDUSTRIE à l'IPSN/DES)
  9. *
  10. *-----------------------------------------------------------
  11. * CALCUL DU POLYNOME MINIMISANT LA DISTANCE A UNE EVOLUTION
  12. *----------------------------------------------------------
  13. 'DEBP' @POMI EV0*'EVOLUTION' N*'ENTIER' PAS1/'FLOTTANT' MT1/'MOT' ;
  14. 'SI' ('EGA' N 0) ;
  15. 'MESS' ' ' ;
  16. 'MESS' '*** POMI ==> Il faut un degré supérieur ou égal à 1' ;
  17. 'MESS' ' ' ;
  18. 'SINON' ;
  19. LX = 'EXTR' EV0 'ABSC' ;
  20. LY = 'EXTR' EV0 'ORDO' ;
  21. GN = 'DIME' LX ;
  22. LKJU = 'PROG' ; LFU = 'PROG' ;
  23.  
  24. * CALCUL DES COEF K
  25. U = -1 ;
  26. 'REPE' BOU1 (N + 1) ;
  27. U = U + 1 ;
  28. J = -1 ;
  29. 'REPE' BOU2 (U + 1) ;
  30. J = J + 1 ;
  31. SOM = 0 ;
  32. I = 0 ;
  33. 'REPE' BOU3 (GN - 1) ;
  34. I = I + 1 ;
  35. XI = 'EXTR' LX I ;
  36. XIP1 = 'EXTR' LX (I + 1) ;
  37. SOM = SOM + (( XIP1 ** (J + U + 1)) - (XI ** (J + U + 1))) ;
  38. 'FIN' BOU3 ;
  39. KJU = SOM / (J + U + 1) ;
  40. LKJU = LKJU 'ET' ('PROG' KJU) ;
  41. 'FIN' BOU2 ;
  42. 'FIN' BOU1 ;
  43.  
  44. * CALCUL DES COEF F
  45. U = -1 ;
  46. 'REPE' BOU4 (N + 1) ;
  47. U = U + 1 ;
  48. I = 0 ;
  49. SOM1 = 0 ; SOM2 = 0 ;
  50. 'REPE' BOU5 (GN - 1) ;
  51. I = I + 1 ;
  52. XI = 'EXTR' LX I ;
  53. XIP1 = 'EXTR' LX (I + 1) ;
  54. YI = 'EXTR' LY I ;
  55. YIP1 = 'EXTR' LY (I + 1) ;
  56. PENTE = (YIP1 - YI) / (XIP1 - XI) ;
  57. SOM1 = SOM1 + (((XIP1 ** (U + 1)) - (XI ** (U + 1))) *
  58. (YI - (PENTE * XI))) ;
  59. SOM2 = SOM2 + (((XIP1 ** (U + 2)) - (XI ** (U + 2))) * PENTE) ;
  60. 'FIN' BOU5 ;
  61. FU = (SOM1 / (U + 1)) + (SOM2 / (U + 2)) ;
  62. LFU = LFU 'ET' (PROG FU) ;
  63. 'FIN' BOU4 ;
  64.  
  65. * CREATION D UNE GEOMETRIE FICTIVE
  66. 'SI' ('EGA' ('VALE' 'DIME') 3) ;
  67. GEO = 0 0 0 ; NP = 0 ;
  68. 'REPE' BOU63 N ;
  69. NP = NP + 1 ;
  70. GEO = GEO 'ET' (NP 0. 0.) ;
  71. 'FIN' BOU63 ;
  72. 'SINON' ;
  73. 'SI' ('NON' ('EGA' ('VALE' 'DIME') 2)) ;
  74. 'MESS' '*** POMI ==> On se met en dimension 2 pour résoudre.' ;
  75. 'OPTI' 'DIME' 2 ;
  76. 'FINSI' ;
  77. GEO = 0 0 ; NP = 0 ;
  78. 'REPE' BOU6 N ;
  79. NP = NP + 1 ;
  80. GEO = GEO 'ET' (NP 0.) ;
  81. 'FIN' BOU6 ;
  82. 'FINSI' ;
  83.  
  84. * ON DEFINIT LA RIGIDITE
  85. GEO1 = 'MANU' 'SUPE' GEO ;
  86. RI = 'MANU' 'RIGIDITE' TYPE 'RIGIDITE' GEO1 ('MOTS' 'T') LKJU ;
  87.  
  88. * ON DEFINIT LE SECOND MEMBRE
  89. FO = 'MANU' 'CHPO' GEO 1 'Q' LFU ;
  90.  
  91. * ON RESOUD LE SYSTEME D EQUATION
  92. CA = 'RESO' RI FO ;
  93.  
  94. * ON EXTRAIT LES TERMES DU POLYNOME
  95. TA = 'TABLE' ; NA = -1 ;
  96. 'REPE' BOU7 (N + 1) ;
  97. NA = NA + 1 ;
  98. TA.NA = 'EXTR' CA 'T' (GEO 'POIN' (NA + 1)) ;
  99. 'FIN' BOU7 ;
  100.  
  101. * ON TRACE LE POLYNOME
  102. 'SI' ('EXISTE' MT1) ;
  103. 'SI' ('EGA' MT1 IDEM ) ;
  104. XX = LX ; YY = PROG ('DIME' XX) * (TA.0) ;
  105. 'SI' ('EXISTE' PAS1) ;
  106. 'MESS' ' ' ;
  107. 'MESS' '*** POMI ==> Option IDEM, le pas ' PAS1 'est ignoré' ;
  108. 'MESS' ' ' ;
  109. 'FINSI' ;
  110. NA = 0 ;
  111. 'REPE' BOU9 N ;
  112. NA = NA + 1 ;
  113. YY = YY + ((XX ** NA) * (TA.NA)) ;
  114. 'FIN' BOU9 ;
  115. 'SINON' ;
  116. 'MESS' ' ' ;
  117. 'MESS' '*** POMI ==> Mot clé: ' MT1 ' incorrect.' ;
  118. 'MESS' ' ' ;
  119. 'FINSI' ;
  120. 'SINON' ;
  121. X1 = 'EXTR' LX 1 ;
  122. XGN = 'EXTR' LX GN ;
  123. 'SI' ('NON' ('EXISTE' PAS1)) ;
  124. PAS1 = ((XGN - X1) / (GN - 1)) / 4. ;
  125. 'FINSI' ;
  126. XX = 'PROG' X1 'PAS' PAS1 XGN ; YY = PROG ('DIME' XX) * (TA.0) ;
  127. NA = 0 ;
  128. 'REPE' BOU10 N ;
  129. NA = NA + 1 ;
  130. YY = YY + ((XX ** NA) * (TA.NA)) ;
  131. 'FIN' BOU10 ;
  132. 'FINSI' ;
  133. EV1 = 'EVOL' 'ROUG' 'MANU' 'X' XX 'Y' YY ;
  134. 'FINSI' ;
  135. 'FINP' TA EV1 ;
  136.  
  137.  
  138.  

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