1 : * @POINTIR PROCEDUR PASCAL 12/10/18 21:15:02 7532 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 : PTSI1 = 'POIN' LCPTI1 ; 101 : 'SI' IMAIL1 ; 102 : PTINCI1 = ('MANU' 'POI1' PTSI1) 'INCL' MAIL1 TEXT1 'NOID' TOL1 ; 103 : 'SI' (('NBNO' PTINCI1) 'EGA' 0) ; 104 : 'ITER' B1 ; 105 : 'FINS' ; 106 : 'FINS' ; 107 : 'SI' (NPTSI1 'EGA' 0) ; 108 : PTS1 = 'MANU' 'POI1' PTSI1 ; 109 : 'SINO' ; 110 : PTS1 = PTS1 'ET' PTSI1 ; 111 : 'FINS' ; 112 : NPTSI1 = NPTSI1 + 1 ; 113 : 'SI' (NPTSI1 'EGA' NPTS1) ; 114 : 'QUIT' B1 ; 115 : 'FINS' ; 116 : 'FIN' B1 ; 117 : * * 118 : * Nouveau germe si germe auto : * 119 : 'SI' IAUTO1 ; 120 : VECH1 = 'VALE' 'ECHO' ; 121 : IMPR1 = 'VALE' 'IMPR' ; 122 : 'OPTI' 'ECHO' 0 ; 123 : 'OPTI' 'IMPR' 10 'IMPR' './germe' ; 124 : 'MESS' ('ABS' IGER1) ; 125 : 'OPTI' 'IMPR' IMPR1 ; 126 : 'OPTI' 'ECHO' VECH1 ; 127 : 'FINS' ; 128 : * * 129 : 'FINS' ; 130 : * * 131 : *---------------------------------------------------------------------* 132 : * * 133 : * PROCESSUS D'EXCLUSION * 134 : * * 135 : * REPU = ancienne synthaxe pour le processus d'exclusion (repulsion) * 136 : 'SI' (('EGA' DISTRI1 'EXCL') 'OU' ('EGA' DISTRI1 'REPU')) ; 137 : * * 138 : * Arguments processus d'exclusion : * 139 : 'ARGU' ZREP1*'MOT' ; 140 : 'SI' ('EGA' ZREP1 'SPHE') ; 141 : 'ARGU' DREP1*'FLOTTANT' ; 142 : 'SINO' ; 143 : 'MESS' 'On attend le mot-cle SPHE.' ; 144 : 'QUIT' @POINTIR ; 145 : 'FINS' ; 146 : * * 147 : * Initialisation des donnees sur le domaine du tirage : * 148 : 'ARGU' NTIR1/'ENTIER' MAIL1/'MAILLAGE' ; 149 : IMAIL1 = FAUX ; 150 : TMOY1 = 'TABL' ; 151 : TECA1 = 'TABL' ; 152 : 'SI' ('EXIS' MAIL1) ; 153 : IMAIL1 = VRAI ; 154 : MESTIR1 = 1. ; 155 : LCPTMIN1 = 'PROG' ; 156 : 'REPE' B0 IDIM1 ; 157 : MINI1 = 'MINI' ('COOR' &B0 MAIL1) ; 158 : MAXI1 = 'MAXI' ('COOR' &B0 MAIL1) ; 159 : MESTIR1 = MESTIR1 * (MAXI1 - MINI1) ; 160 : LCPTMIN1 = LCPTMIN1 'ET' ('PROG' MINI1) ; 161 : TMOY1 . &B0 = 0.5 * (MAXI1 + MINI1) ; 162 : TECA1 . &B0 = 0.5 * (MAXI1 - MINI1) ; 163 : 'FIN' B0 ; 164 : RTIR1 = 1.2 * MESTIR1 / ('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 : IGER1 = 1 ; 181 : IAUTO1 = FAUX ; 182 : 'REPE' XB0 2 ; 183 : 'ARGU' MOT1/'MOT' ; 184 : 'SI' ('EXIS' MOT1) ; 185 : 'SI' ('EGA' MOT1 'PINI') ; 186 : 'ARGU' PTS2*'MAILLAGE' ; 187 : IPTS2 = VRAI ; 188 : 'ITER' XB0 ; 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 : 'FINS' ; 206 : 'FIN' XB0 ; 207 : * * 208 : * Tirage des points : * 209 : NB1 = NTIR1 ; 210 : TVAR1 = 'TABL' ; 211 : 'REPE' B0 IDIM1 ; 212 : TVAR1 . &B0 = 'BRUI' 'BLAN' 'UNIF' (TMOY1 . &B0) (TECA1 . &B0) 213 : NB1 IGER1 ; 214 : IGER1 = 'ABS' ('ENTI' (1.E5 * ('EXTR' (TVAR1 . &B0) 1))) ; 215 : 'FIN' B0 ; 216 : NPTSI1 = 0 ; 217 : 'REPE' B1 NB1 ; 218 : IP1 = &B1 ; 219 : LCPTI1 = 'PROG' ; 220 : 'REPE' B0 IDIM1 ; 221 : LCPTI1 = LCPTI1 'ET' ('PROG' ('EXTR' (TVAR1 . &B0) IP1)) ; 222 : 'FIN' B0 ; 223 : PTSI1 = 'POIN' LCPTI1 ; 224 : 'SI' IMAIL1 ; 225 : PTINCI1 = ('MANU' 'POI1' PTSI1) 'INCL' MAIL1 TEXT1 'NOID' TOL1 ; 226 : 'SI' (('NBNO' PTINCI1) 'EGA' 0) ; 227 : 'ITER' B1 ; 228 : 'FINS' ; 229 : 'FINS' ; 230 : 'SI' IPTS2 ; 231 : 'SI' (NPTSI1 'EGA' 0) ; 232 : PTSI2 = PTS2 'POIN' 'PROC' PTSI1 ; 233 : 'SINO' ; 234 : PTSI2 = (PTS1 'ET' PTS2) 'POIN' 'PROC' PTSI1 ; 235 : 'FINS' ; 236 : DI2 = 'NORM' (PTSI2 'MOIN' PTSI1) ; 237 : 'SI' (DI2 '>EG' DREP1) ; 238 : 'SI' (NPTSI1 'EGA' 0) ; 239 : PTS1 = 'MANU' 'POI1' PTSI1 ; 240 : 'SINO' ; 241 : PTS1 = PTS1 'ET' PTSI1 ; 242 : 'FINS' ; 243 : NPTSI1 = NPTSI1 + 1 ; 244 : 'FINS' ; 245 : 'SINO' ; 246 : 'SI' (NPTSI1 'EGA' 0) ; 247 : PTS1 = 'MANU' 'POI1' PTSI1 ; 248 : NPTSI1 = NPTSI1 + 1 ; 249 : 'SINO' ; 250 : PTSI2 = PTS1 'POIN' 'PROC' PTSI1 ; 251 : DI2 = 'NORM' (PTSI2 'MOIN' PTSI1) ; 252 : 'SI' (DI2 '>EG' DREP1) ; 253 : PTS1 = PTS1 'ET' PTSI1 ; 254 : NPTSI1 = NPTSI1 + 1 ; 255 : 'FINS' ; 256 : 'FINS' ; 257 : 'FINS' ; 258 : 'SI' (NPTSI1 'EGA' NPTS1) ; 259 : 'QUIT' B1 ; 260 : 'FINS' ; 261 : 'FIN' B1 ; 262 : * * 263 : * Creation d'un maillage vide si aucun point tire : * 264 : 'SI' (NPTSI1 'EGA' 0) ; 265 : PTSI1 = 'MANU' 'POI1' PTSI1 ; 266 : PTS1 = PTSI1 'DIFF' PTSI1 ; 267 : 'FINS' ; 268 : * * 269 : * Nouveau germe si germe auto : * 270 : 'SI' IAUTO1 ; 271 : VECH1 = 'VALE' 'ECHO' ; 272 : IMPR1 = 'VALE' 'IMPR' ; 273 : 'OPTI' 'ECHO' 0 ; 274 : 'OPTI' 'IMPR' 10 'IMPR' './germe' ; 275 : 'MESS' ('ABS' IGER1) ; 276 : 'OPTI' 'IMPR' IMPR1 ; 277 : 'OPTI' 'ECHO' VECH1 ; 278 : 'FINS' ; 279 : * * 280 : 'FINS' ; 281 : * * 282 : *---------------------------------------------------------------------* 283 : * * 284 : * Message : * 285 : 'SAUT' 1 'LIGN' ; 286 : 'MESS' '*** Procedure @POINTIR :' ; 287 : 'MESS' '*** ' NPTSI1 '/' NPTS1 'points places pour' IP1 288 : 'tirages effectues.' ; 289 : 'SAUT' 1 'LIGN' ; 290 : * * 291 : 'RESP' PTS1 ; 292 : 'FINP' ; 293 :
© Cast3M 2003 - All rights reserved.
Disclaimer