Télécharger la plaquette Cast3M


fr en

Télécharger @pointir.procedur

Retour à la liste

Numérotation des lignes : 

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

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