Télécharger la plaquette Cast3M


fr en

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