Télécharger la plaquette Cast3M


fr en

Télécharger @pointir.procedur

Retour à la liste

Numérotation des lignes : 

  1. * @POINTIR  PROCEDUR  FD218221  20/03/11    21:15:01     10549          
  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.                         ('EXTR' (TVAR1 . 2 ) IP1) ;
  106.     'FINSI' ;
  107.     'SI' (('VALE' 'DIME') 'EGA' 3) ;
  108.       PTSI1    = 'POIN' ('EXTR' (TVAR1 . 1 ) IP1)
  109.                         ('EXTR' (TVAR1 . 2 ) IP1)
  110.                         ('EXTR' (TVAR1 . 3 ) IP1) ;
  111.     'FINSI';
  112. * CB215821 : Ancienne Syntaxe retirée en 2015
  113. *    PTSI1    = 'POIN' LCPTI1 ;
  114.     'SI' IMAIL1 ;
  115.       PTINCI1  = ('MANU' 'POI1' PTSI1) 'INCL' MAIL1 TEXT1 'NOID' TOL1 ;
  116.       'SI' (('NBNO' PTINCI1) 'EGA' 0) ;
  117.         'ITER' B1 ;
  118.       'FINS' ;
  119.     'FINS' ;
  120.     'SI' (NPTSI1 'EGA' 0) ;
  121.       PTS1     = 'MANU' 'POI1' PTSI1 ;
  122.     'SINO' ;
  123.       PTS1     = PTS1 'ET' PTSI1 ;
  124.     'FINS' ;
  125.     NPTSI1   = NPTSI1 + 1 ;
  126.     'SI' (NPTSI1 'EGA' NPTS1) ;
  127.       'QUIT' B1 ;
  128.     'FINS' ;
  129.   'FIN' B1 ;
  130. *                                                                     *
  131. * Nouveau germe si germe auto :                                       *
  132.   'SI' IAUTO1 ;
  133.     VECH1    = 'VALE' 'ECHO' ;
  134.     IMPR1    = 'VALE' 'IMPR' ;
  135.     'OPTI' 'ECHO' 0 ;
  136.     'OPTI' 'IMPR' 10 'IMPR' './germe' ;
  137.     'MESS' ('ABS' IGER1) ;
  138.     'OPTI' 'IMPR' IMPR1 ;
  139.     'OPTI' 'ECHO' VECH1 ;
  140.   'FINS' ;
  141. *                                                                     *
  142. 'FINS' ;
  143. *                                                                     *
  144. *---------------------------------------------------------------------*
  145. *                                                                     *
  146. *                        PROCESSUS D'EXCLUSION                        *
  147. *                                                                     *
  148. * REPU = ancienne synthaxe pour le processus d'exclusion (repulsion)  *
  149. 'SI' (('EGA' DISTRI1 'EXCL') 'OU' ('EGA' DISTRI1 'REPU')) ;
  150. *                                                                     *
  151. * Arguments processus d'exclusion :                                   *
  152.   'ARGU' ZREP1*'MOT' ;
  153.   'SI' ('EGA' ZREP1 'SPHE') ;
  154.     'ARGU' DREP1*'FLOTTANT' ;
  155.   'SINO' ;
  156.     'MESS' 'On attend le mot-cle SPHE.' ;
  157.     'QUIT' @POINTIR ;
  158.   'FINS' ;
  159. *                                                                     *
  160. * Initialisation des donnees sur le domaine du tirage :               *
  161.   'ARGU' NTIR1/'ENTIER' MAIL1/'MAILLAGE' ;
  162.   IMAIL1   = FAUX ;
  163.   TMOY1    = 'TABL' ;
  164.   TECA1    = 'TABL' ;
  165.   'SI' ('EXIS' MAIL1) ;
  166.     IMAIL1   = VRAI ;
  167.     MESTIR1  = 1. ;
  168.     LCPTMIN1 = 'PROG' ;
  169.     'REPE' B0 IDIM1 ;
  170.       MINI1    = 'MINI' ('COOR' &B0 MAIL1) ;
  171.       MAXI1    = 'MAXI' ('COOR' &B0 MAIL1) ;
  172.       MESTIR1  = MESTIR1 * (MAXI1 - MINI1) ;
  173.       LCPTMIN1 = LCPTMIN1 'ET' ('PROG' MINI1) ;
  174.       TMOY1 . &B0 = 0.5 * (MAXI1 + MINI1) ;
  175.       TECA1 . &B0 = 0.5 * (MAXI1 - MINI1) ;
  176.     'FIN' B0 ;
  177.     RTIR1    = 1.2 * MESTIR1 / ('MESU' MAIL1) ;
  178.   'SINO' ;
  179.     'REPE' B0 IDIM1 ;
  180.       TMOY1 . &B0 = 0.5 ;
  181.       TECA1 . &B0 = 0.5 ;
  182.     'FIN' B0 ;
  183.     RTIR1    = 1. ;
  184.   'FINS' ;
  185. *                                                                     *
  186. * Initialisation du nombre de tirages : NTIR1                         *
  187.   'SI' ('NON' ('EXIS' NTIR1)) ;
  188.     NTIR1    = 25 * ('ENTI' (('FLOT' NPTS1) * RTIR1)) ;
  189.   'FINS' ;
  190. *                                                                     *
  191. * Initialisation des points du tirage et du germe :                   *
  192.   IPTS2    = FAUX ;
  193.   IGER1    = 1 ;
  194.   IAUTO1   = FAUX ;
  195.   'REPE' XB0 2 ;
  196.     'ARGU' MOT1/'MOT' ;
  197.     'SI' ('EXIS' MOT1) ;
  198.       'SI' ('EGA' MOT1 'PINI') ;
  199.         'ARGU' PTS2*'MAILLAGE' ;
  200.           IPTS2    = VRAI ;
  201.         'ITER' XB0 ;
  202.       'FINS' ;
  203.       'SI' ('EGA' MOT1 'GERM') ;
  204.         'ARGU' MOT1/'MOT' ;
  205.         'SI' (('EXIS' MOT1) 'ET' ('EGA' MOT1 'AUTO')) ;
  206.           IAUTO1   = VRAI ;
  207.           'OPTI' 'ERRE' 'CONT' ;
  208.           'OPTI' 'ACQU' 10 'ACQU' './germe' ;
  209.           'ACQU' IGER2*'ENTIER' ;
  210.           'OPTI' 'ERRE' 'NORM' ;
  211.           'SI' ('EGA' ('TYPE' IGER2) 'ENTIER') ;
  212.             IGER1    = 'ABS' IGER2 ;
  213.           'FINS' ;
  214.         'SINO' ;
  215.           'ARGU' IGER1*'ENTIER' ;
  216.         'FINS' ;
  217.       'FINS' ;
  218.     'FINS' ;
  219.   'FIN' XB0 ;
  220. *                                                                     *
  221. * Tirage des points :                                                 *
  222.   NB1      = NTIR1 ;
  223.   TVAR1    = 'TABL' ;
  224.   'REPE' B0 IDIM1 ;
  225.     TVAR1 . &B0 = 'BRUI' 'BLAN' 'UNIF' (TMOY1 . &B0) (TECA1 . &B0)
  226.       NB1 IGER1 ;
  227.     IGER1    = 'ABS' ('ENTI' (1.E5 * ('EXTR' (TVAR1 . &B0) 1))) ;
  228.   'FIN' B0 ;
  229.   NPTSI1   = 0 ;
  230.   'REPE' B1 NB1 ;
  231.     IP1      = &B1 ;
  232.     LCPTI1   = 'PROG' ;
  233.     'REPE' B0 IDIM1 ;
  234.       LCPTI1   = LCPTI1 'ET' ('PROG' ('EXTR' (TVAR1 . &B0) IP1)) ;
  235.     'FIN' B0 ;
  236.      SI ((VALE DIME) EGA 1);
  237.        PTSI1    = 'POIN' ('EXTR' (TVAR1 . 1 ) IP1) ;
  238.      FINSI;
  239.      SI ((VALE DIME) EGA 2);
  240.        PTSI1    = 'POIN' ('EXTR' (TVAR1 . 1 ) IP1)
  241.                          ('EXTR' (TVAR1 . 2 ) IP1) ;
  242.      FINSI;
  243.      SI ((VALE DIME) EGA 3);
  244.        PTSI1    = 'POIN' ('EXTR' (TVAR1 . 1 ) IP1)
  245.                          ('EXTR' (TVAR1 . 2 ) IP1)
  246.                          ('EXTR' (TVAR1 . 3 ) IP1) ;
  247.      FINSI;
  248. * CB215821 : Ancienne Syntaxe retirée en 2015
  249. *    PTSI1    = 'POIN' LCPTI1 ;
  250.     'SI' IMAIL1 ;
  251.       PTINCI1  = ('MANU' 'POI1' PTSI1) 'INCL' MAIL1 TEXT1 'NOID' TOL1 ;
  252.       'SI' (('NBNO' PTINCI1) 'EGA' 0) ;
  253.         'ITER' B1 ;
  254.       'FINS' ;
  255.     'FINS' ;
  256.     'SI' IPTS2 ;
  257.       'SI' (NPTSI1 'EGA' 0) ;
  258.         PTSI2    = PTS2 'POIN' 'PROC' PTSI1 ;
  259.       'SINO' ;
  260.         PTSI2    = (PTS1 'ET' PTS2) 'POIN' 'PROC' PTSI1 ;
  261.       'FINS' ;
  262.       DI2      = 'NORM' (PTSI2 'MOIN' PTSI1) ;
  263.       'SI' (DI2 '>EG' DREP1) ;
  264.         'SI' (NPTSI1 'EGA' 0) ;
  265.           PTS1     = 'MANU' 'POI1' PTSI1 ;
  266.         'SINO' ;
  267.           PTS1     = PTS1 'ET' PTSI1 ;
  268.         'FINS' ;
  269.         NPTSI1   = NPTSI1 + 1 ;
  270.       'FINS' ;
  271.     'SINO' ;
  272.       'SI' (NPTSI1 'EGA' 0) ;
  273.         PTS1     = 'MANU' 'POI1' PTSI1 ;
  274.         NPTSI1   = NPTSI1 + 1 ;
  275.       'SINO' ;
  276.          PTSI2    = PTS1 'POIN' 'PROC' PTSI1 ;
  277.          DI2      = 'NORM' (PTSI2 'MOIN' PTSI1) ;
  278.          'SI' (DI2 '>EG' DREP1) ;
  279.            PTS1     = PTS1 'ET' PTSI1 ;
  280.            NPTSI1   = NPTSI1 + 1 ;
  281.          'FINS' ;
  282.       'FINS' ;
  283.     'FINS' ;
  284.     'SI' (NPTSI1 'EGA' NPTS1) ;
  285.       'QUIT' B1 ;
  286.     'FINS' ;
  287.   'FIN' B1 ;
  288. *                                                                     *
  289. * Creation d'un maillage vide si aucun point tire :                   *
  290.   'SI' (NPTSI1 'EGA' 0) ;
  291.     PTSI1    = 'MANU' 'POI1' PTSI1 ;
  292.     PTS1     = PTSI1 'DIFF' PTSI1 ;
  293.   'FINS' ;
  294. *                                                                     *
  295. * Nouveau germe si germe auto :                                       *
  296.   'SI' IAUTO1 ;
  297.     VECH1    = 'VALE' 'ECHO' ;
  298.     IMPR1    = 'VALE' 'IMPR' ;
  299.     'OPTI' 'ECHO' 0 ;
  300.     'OPTI' 'IMPR' 10 'IMPR' './germe' ;
  301.     'MESS' ('ABS' IGER1) ;
  302.     'OPTI' 'IMPR' IMPR1 ;
  303.     'OPTI' 'ECHO' VECH1 ;
  304.   'FINS' ;
  305. *                                                                     *
  306. 'FINS' ;
  307. *                                                                     *
  308. *---------------------------------------------------------------------*
  309. *                                                                     *
  310. * Message :                                                           *
  311. 'SAUT' 1 'LIGN' ;
  312. 'MESS' '*** Procedure @POINTIR :' ;
  313. 'MESS' '***' ' ' NPTSI1 ' /' ' ' NPTS1 ' points places pour' ' ' IP1 ' tirages effectues.' ;
  314. 'SAUT' 1 'LIGN' ;
  315. *                                                                     *
  316. 'RESP' PTS1 ;
  317. 'FINP' ;
  318.  

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