Télécharger la plaquette Cast3M


fr en

Télécharger @pointir.procedur

Retour à la liste

Numérotation des lignes : 

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

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