Télécharger @pointir.procedur

Retour à la liste

Numérotation des lignes :

  1. * @POINTIR PROCEDUR CB215821 15/04/13 21:15:01 8482
  2. 'DEBP' @POINTIR ;
  3. * *
  4. *---------------------------------------------------------------------*
  5. * *
  6. * PTS1 = @POINTIR | 'UNIF' N1 | (MAIL1) ('PINI' PTS2) *
  7. * | 'EXCL' N1 'SPHE' D1 (N2) | *
  8. * *
  9. * ... ('GERM' IGER1) ; *
  10. * *
  11. *---------------------------------------------------------------------*
  12. * *
  13. * Acquisition des arguments : *
  14. 'ARGU' DISTRI1*'MOT' NPTS1*'ENTIER' ;
  15. * *
  16. * Dimensions de travail (IDIM1) :
  17. IDIM1 = 'VALE' 'DIME' ;
  18. * *
  19. * Je cree le texte 'VOLU' 'SI' 'DIME' = 3 pour l'op. 'INCL' : *
  20. 'SI' (IDIM1 'EGA' 3) ;
  21. TEXT1 = 'TEXT' ('MOT' 'VOLU') ;
  22. 'SINO' ;
  23. TEXT1 = 'TEXT' ('MOT' ' ') ;
  24. 'FINS' ;
  25. * *
  26. * Precision pour l'operateur INCLus : *
  27. TOL1 = -1.E-5 ;
  28. * *
  29. *---------------------------------------------------------------------*
  30. * *
  31. * DISTRIBUTION UNIFORME *
  32. * *
  33. 'SI' ('EGA' DISTRI1 'UNIF') ;
  34. * *
  35. * Arguments optionnels : *
  36. * *
  37. * Initialisation des donnees sur le domaine du tirage : *
  38. 'ARGU' MAIL1/'MAILLAGE' ;
  39. IMAIL1 = FAUX ;
  40. TMOY1 = 'TABL' ;
  41. TECA1 = 'TABL' ;
  42. 'SI' ('EXIS' MAIL1) ;
  43. IMAIL1 = VRAI ;
  44. MESTIR1 = 1. ;
  45. LCPTMIN1 = 'PROG' ;
  46. 'REPE' B0 IDIM1 ;
  47. MINI1 = 'MINI' ('COOR' &B0 MAIL1) ;
  48. MAXI1 = 'MAXI' ('COOR' &B0 MAIL1) ;
  49. MESTIR1 = MESTIR1 * (MAXI1 - MINI1) ;
  50. LCPTMIN1 = LCPTMIN1 'ET' ('PROG' MINI1) ;
  51. TMOY1 . &B0 = 0.5 * (MAXI1 + MINI1) ;
  52. TECA1 . &B0 = 0.5 * (MAXI1 - MINI1) ;
  53. 'FIN' B0 ;
  54. RTIR1 = 1.2 * MESTIR1 / ('MESU' MAIL1) ;
  55. 'SINO' ;
  56. 'REPE' B0 IDIM1 ;
  57. TMOY1 . &B0 = 0.5 ;
  58. TECA1 . &B0 = 0.5 ;
  59. 'FIN' B0 ;
  60. RTIR1 = 1. ;
  61. 'FINS' ;
  62. * *
  63. * Valeur du germe : *
  64. IGER1 = 1 ;
  65. IAUTO1 = FAUX ;
  66. 'ARGU' MOT1/'MOT' ;
  67. 'SI' ('EXIS' MOT1) ;
  68. 'SI' ('EGA' MOT1 'GERM') ;
  69. 'ARGU' MOT1/'MOT' ;
  70. 'SI' (('EXIS' MOT1) 'ET' ('EGA' MOT1 'AUTO')) ;
  71. IAUTO1 = VRAI ;
  72. 'OPTI' 'ERRE' 'CONT' ;
  73. 'OPTI' 'ACQU' 10 'ACQU' './germe' ;
  74. 'ACQU' IGER2*'ENTIER' ;
  75. 'OPTI' 'ERRE' 'NORM' ;
  76. 'SI' ('EGA' ('TYPE' IGER2) 'ENTIER') ;
  77. IGER1 = 'ABS' IGER2 ;
  78. 'FINS' ;
  79. 'SINO' ;
  80. 'ARGU' IGER1*'ENTIER' ;
  81. 'FINS' ;
  82. 'FINS' ;
  83. 'FINS' ;
  84. * *
  85. * Tirage des points : *
  86. NB1 = 'ENTI' (('FLOT' NPTS1) * RTIR1) ;
  87. TVAR1 = 'TABL' ;
  88. 'REPE' B0 IDIM1 ;
  89. TVAR1 . &B0 = 'BRUI' 'BLAN' 'UNIF' (TMOY1 . &B0) (TECA1 . &B0)
  90. NB1 IGER1 ;
  91. IGER1 = 'ABS' ('ENTI' (1.E5 * ('EXTR' (TVAR1 . &B0) 1))) ;
  92. 'FIN' B0 ;
  93. NPTSI1 = 0 ;
  94. 'REPE' B1 NB1 ;
  95. IP1 = &B1 ;
  96. LCPTI1 = 'PROG' ;
  97. 'REPE' B0 IDIM1 ;
  98. LCPTI1 = LCPTI1 'ET' ('PROG' ('EXTR' (TVAR1 . &B0) IP1)) ;
  99. 'FIN' B0 ;
  100. SI ((VALE DIME) EGA 1);
  101. PTSI1 = 'POIN' ('EXTR' (TVAR1 . 1) IP1) ;
  102. FINSI;
  103. SI ((VALE DIME) EGA 2);
  104. PTSI1 = 'POIN' ('EXTR' (TVAR1 . 1) IP1) ;
  105. FINSI;
  106. SI ((VALE DIME) EGA 3);
  107. PTSI1 = 'POIN' ('EXTR' (TVAR1 . 1) IP1) ;
  108. FINSI;
  109. * CB215821 : Ancienne Syntaxe retirée en 2015
  110. * PTSI1 = 'POIN' LCPTI1 ;
  111. 'SI' IMAIL1 ;
  112. PTINCI1 = ('MANU' 'POI1' PTSI1) 'INCL' MAIL1 TEXT1 'NOID' TOL1 ;
  113. 'SI' (('NBNO' PTINCI1) 'EGA' 0) ;
  114. 'ITER' B1 ;
  115. 'FINS' ;
  116. 'FINS' ;
  117. 'SI' (NPTSI1 'EGA' 0) ;
  118. PTS1 = 'MANU' 'POI1' PTSI1 ;
  119. 'SINO' ;
  120. PTS1 = PTS1 'ET' PTSI1 ;
  121. 'FINS' ;
  122. NPTSI1 = NPTSI1 + 1 ;
  123. 'SI' (NPTSI1 'EGA' NPTS1) ;
  124. 'QUIT' B1 ;
  125. 'FINS' ;
  126. 'FIN' B1 ;
  127. * *
  128. * Nouveau germe si germe auto : *
  129. 'SI' IAUTO1 ;
  130. VECH1 = 'VALE' 'ECHO' ;
  131. IMPR1 = 'VALE' 'IMPR' ;
  132. 'OPTI' 'ECHO' 0 ;
  133. 'OPTI' 'IMPR' 10 'IMPR' './germe' ;
  134. 'MESS' ('ABS' IGER1) ;
  135. 'OPTI' 'IMPR' IMPR1 ;
  136. 'OPTI' 'ECHO' VECH1 ;
  137. 'FINS' ;
  138. * *
  139. 'FINS' ;
  140. * *
  141. *---------------------------------------------------------------------*
  142. * *
  143. * PROCESSUS D'EXCLUSION *
  144. * *
  145. * REPU = ancienne synthaxe pour le processus d'exclusion (repulsion) *
  146. 'SI' (('EGA' DISTRI1 'EXCL') 'OU' ('EGA' DISTRI1 'REPU')) ;
  147. * *
  148. * Arguments processus d'exclusion : *
  149. 'ARGU' ZREP1*'MOT' ;
  150. 'SI' ('EGA' ZREP1 'SPHE') ;
  151. 'ARGU' DREP1*'FLOTTANT' ;
  152. 'SINO' ;
  153. 'MESS' 'On attend le mot-cle SPHE.' ;
  154. 'QUIT' @POINTIR ;
  155. 'FINS' ;
  156. * *
  157. * Initialisation des donnees sur le domaine du tirage : *
  158. 'ARGU' NTIR1/'ENTIER' MAIL1/'MAILLAGE' ;
  159. IMAIL1 = FAUX ;
  160. TMOY1 = 'TABL' ;
  161. TECA1 = 'TABL' ;
  162. 'SI' ('EXIS' MAIL1) ;
  163. IMAIL1 = VRAI ;
  164. MESTIR1 = 1. ;
  165. LCPTMIN1 = 'PROG' ;
  166. 'REPE' B0 IDIM1 ;
  167. MINI1 = 'MINI' ('COOR' &B0 MAIL1) ;
  168. MAXI1 = 'MAXI' ('COOR' &B0 MAIL1) ;
  169. MESTIR1 = MESTIR1 * (MAXI1 - MINI1) ;
  170. LCPTMIN1 = LCPTMIN1 'ET' ('PROG' MINI1) ;
  171. TMOY1 . &B0 = 0.5 * (MAXI1 + MINI1) ;
  172. TECA1 . &B0 = 0.5 * (MAXI1 - MINI1) ;
  173. 'FIN' B0 ;
  174. RTIR1 = 1.2 * MESTIR1 / ('MESU' MAIL1) ;
  175. 'SINO' ;
  176. 'REPE' B0 IDIM1 ;
  177. TMOY1 . &B0 = 0.5 ;
  178. TECA1 . &B0 = 0.5 ;
  179. 'FIN' B0 ;
  180. RTIR1 = 1. ;
  181. 'FINS' ;
  182. * *
  183. * Initialisation du nombre de tirages : NTIR1 *
  184. 'SI' ('NON' ('EXIS' NTIR1)) ;
  185. NTIR1 = 25 * ('ENTI' (('FLOT' NPTS1) * RTIR1)) ;
  186. 'FINS' ;
  187. * *
  188. * Initialisation des points du tirage et du germe : *
  189. IPTS2 = FAUX ;
  190. IGER1 = 1 ;
  191. IAUTO1 = FAUX ;
  192. 'REPE' XB0 2 ;
  193. 'ARGU' MOT1/'MOT' ;
  194. 'SI' ('EXIS' MOT1) ;
  195. 'SI' ('EGA' MOT1 'PINI') ;
  196. 'ARGU' PTS2*'MAILLAGE' ;
  197. IPTS2 = VRAI ;
  198. 'ITER' XB0 ;
  199. 'FINS' ;
  200. 'SI' ('EGA' MOT1 'GERM') ;
  201. 'ARGU' MOT1/'MOT' ;
  202. 'SI' (('EXIS' MOT1) 'ET' ('EGA' MOT1 'AUTO')) ;
  203. IAUTO1 = VRAI ;
  204. 'OPTI' 'ERRE' 'CONT' ;
  205. 'OPTI' 'ACQU' 10 'ACQU' './germe' ;
  206. 'ACQU' IGER2*'ENTIER' ;
  207. 'OPTI' 'ERRE' 'NORM' ;
  208. 'SI' ('EGA' ('TYPE' IGER2) 'ENTIER') ;
  209. IGER1 = 'ABS' IGER2 ;
  210. 'FINS' ;
  211. 'SINO' ;
  212. 'ARGU' IGER1*'ENTIER' ;
  213. 'FINS' ;
  214. 'FINS' ;
  215. 'FINS' ;
  216. 'FIN' XB0 ;
  217. * *
  218. * Tirage des points : *
  219. NB1 = NTIR1 ;
  220. TVAR1 = 'TABL' ;
  221. 'REPE' B0 IDIM1 ;
  222. TVAR1 . &B0 = 'BRUI' 'BLAN' 'UNIF' (TMOY1 . &B0) (TECA1 . &B0)
  223. NB1 IGER1 ;
  224. IGER1 = 'ABS' ('ENTI' (1.E5 * ('EXTR' (TVAR1 . &B0) 1))) ;
  225. 'FIN' B0 ;
  226. NPTSI1 = 0 ;
  227. 'REPE' B1 NB1 ;
  228. IP1 = &B1 ;
  229. LCPTI1 = 'PROG' ;
  230. 'REPE' B0 IDIM1 ;
  231. LCPTI1 = LCPTI1 'ET' ('PROG' ('EXTR' (TVAR1 . &B0) IP1)) ;
  232. 'FIN' B0 ;
  233. SI ((VALE DIME) EGA 1);
  234. PTSI1 = 'POIN' ('EXTR' (TVAR1 . 1 ) IP1) ;
  235. FINSI;
  236. SI ((VALE DIME) EGA 2);
  237. PTSI1 = 'POIN' ('EXTR' (TVAR1 . 1 ) IP1)
  238. ('EXTR' (TVAR1 . 2 ) IP1) ;
  239. FINSI;
  240. SI ((VALE DIME) EGA 3);
  241. PTSI1 = 'POIN' ('EXTR' (TVAR1 . 1 ) IP1)
  242. ('EXTR' (TVAR1 . 2 ) IP1)
  243. ('EXTR' (TVAR1 . 3 ) IP1) ;
  244. FINSI;
  245. * CB215821 : Ancienne Syntaxe retirée en 2015
  246. * PTSI1 = 'POIN' LCPTI1 ;
  247. 'SI' IMAIL1 ;
  248. PTINCI1 = ('MANU' 'POI1' PTSI1) 'INCL' MAIL1 TEXT1 'NOID' TOL1 ;
  249. 'SI' (('NBNO' PTINCI1) 'EGA' 0) ;
  250. 'ITER' B1 ;
  251. 'FINS' ;
  252. 'FINS' ;
  253. 'SI' IPTS2 ;
  254. 'SI' (NPTSI1 'EGA' 0) ;
  255. PTSI2 = PTS2 'POIN' 'PROC' PTSI1 ;
  256. 'SINO' ;
  257. PTSI2 = (PTS1 'ET' PTS2) 'POIN' 'PROC' PTSI1 ;
  258. 'FINS' ;
  259. DI2 = 'NORM' (PTSI2 'MOIN' PTSI1) ;
  260. 'SI' (DI2 '>EG' DREP1) ;
  261. 'SI' (NPTSI1 'EGA' 0) ;
  262. PTS1 = 'MANU' 'POI1' PTSI1 ;
  263. 'SINO' ;
  264. PTS1 = PTS1 'ET' PTSI1 ;
  265. 'FINS' ;
  266. NPTSI1 = NPTSI1 + 1 ;
  267. 'FINS' ;
  268. 'SINO' ;
  269. 'SI' (NPTSI1 'EGA' 0) ;
  270. PTS1 = 'MANU' 'POI1' PTSI1 ;
  271. NPTSI1 = NPTSI1 + 1 ;
  272. 'SINO' ;
  273. PTSI2 = PTS1 'POIN' 'PROC' PTSI1 ;
  274. DI2 = 'NORM' (PTSI2 'MOIN' PTSI1) ;
  275. 'SI' (DI2 '>EG' DREP1) ;
  276. PTS1 = PTS1 'ET' PTSI1 ;
  277. NPTSI1 = NPTSI1 + 1 ;
  278. 'FINS' ;
  279. 'FINS' ;
  280. 'FINS' ;
  281. 'SI' (NPTSI1 'EGA' NPTS1) ;
  282. 'QUIT' B1 ;
  283. 'FINS' ;
  284. 'FIN' B1 ;
  285. * *
  286. * Creation d'un maillage vide si aucun point tire : *
  287. 'SI' (NPTSI1 'EGA' 0) ;
  288. PTSI1 = 'MANU' 'POI1' PTSI1 ;
  289. PTS1 = PTSI1 'DIFF' PTSI1 ;
  290. 'FINS' ;
  291. * *
  292. * Nouveau germe si germe auto : *
  293. 'SI' IAUTO1 ;
  294. VECH1 = 'VALE' 'ECHO' ;
  295. IMPR1 = 'VALE' 'IMPR' ;
  296. 'OPTI' 'ECHO' 0 ;
  297. 'OPTI' 'IMPR' 10 'IMPR' './germe' ;
  298. 'MESS' ('ABS' IGER1) ;
  299. 'OPTI' 'IMPR' IMPR1 ;
  300. 'OPTI' 'ECHO' VECH1 ;
  301. 'FINS' ;
  302. * *
  303. 'FINS' ;
  304. * *
  305. *---------------------------------------------------------------------*
  306. * *
  307. * Message : *
  308. 'SAUT' 1 'LIGN' ;
  309. 'MESS' '*** Procedure @POINTIR :' ;
  310. 'MESS' '*** ' NPTSI1 '/' NPTS1 'points places pour' IP1
  311. 'tirages effectues.' ;
  312. 'SAUT' 1 'LIGN' ;
  313. * *
  314. 'RESP' PTS1 ;
  315. 'FINP' ;
  316.  
  317.  
  318.  

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