1 : C BRUI SOURCE CHAT 07/10/29 21:15:37 5940 2 : SUBROUTINE BRUI 3 : C----------------------------------------------------------------------- 4 : C Génération d'un bruit blanc obéissant à une loi statistique décrite 5 : C via les arguments transmis. Ce bruit est utilisée pour créer : 6 : C 1) Un LISTREEL lorsque on donne le nombre de valeurs à générer ; 7 : C 2) Un objet EVOLUTION si un LISTREEL de temps est fourni ; 8 : C 3) Un CHAMPOINT si le maillage GEO1 est précisé ; 9 : C 4) Un LISTENTI lorsqu'on tire des variables entiere selon un 10 : C processus de Poisson. 11 : C----------------------------------------------------------------------- 12 : C 13 : C--------------------------- 14 : C Phrase d'appel (GIBIANE) : 15 : C--------------------------- 16 : C 17 : C | ENTI2 | 18 : C RES1 = 'BRUI' 'BLAN' MOT1 FLOT1 (FLOT2) | LREEL1 (COUL) | (ENTI3) ; 19 : C | GEO1 | 20 : C ou 21 : C 22 : C RES1 = 'BRUI' 'BLAN' 'POIS' ENTI1 ENTI2 (ENTI3) 23 : C 24 : C------------------------ 25 : C Opérandes et résultat : 26 : C------------------------ 27 : C 28 : C 1e Syntaxe : 29 : C ------------ 30 : C 31 : C BLAN : Mot indiquant qu'il s'agit d'un bruit blanc 32 : C MOT1 : Mot indiquant la loi statistique suivi par le bruit : 33 : C MOT1 = 'GAUS' : Distribution gaussienne, 34 : C MOT1 = 'UNIF' : Distribution uniforme, 35 : C MOT1 = 'EXPO' : Distribution exponentielle. 36 : C FLOT1 : Moyenne statistique du bruit à créer. Ne sert à rien 37 : C si MOT1='EXPO'. 38 : C FLOT2 : Ecart type du bruit à créer. Ne sert à rien si MOT1='POIS'. 39 : C ENTI2 : Nombre de valeurs du LISTREEL à générer. 40 : C LREEL1 : LISTREEL contenant la liste des temps pour l'EVOLUTION. 41 : C COUL : Mot clef indiquant la couleur associée à l'EVOLUTION RES1. 42 : C GEO1 : Maillage contenant le support géométrique du CHAMPOINT. 43 : C ENTI3 : Entier positif ou nul. Modifie l'initialisation du bruit. 44 : C 45 : C RES1 : LISTREEL, EVOLUTION, CHAMPOINT selon la syntaxe utilisée. 46 : C 47 : C 2e Syntaxe : 48 : C ------------ 49 : C 50 : C BLAN : Mot indiquant qu'il s'agit d'un bruit blanc 51 : C 'POIS' : Mot-cle que les valeurs suivent une distribution de Poisson. 52 : C ENTI1 : Valeur moyenne de la distribution. 53 : C ENTI2 : Nombre de valeurs du LISTENTI à générer. 54 : C ENTI3 : Entier positif ou nul. Modifie l'initialisation du bruit. 55 : C 56 : C RES1 : Resultat, LISTENTI de valeurs aleatoires. 57 : C 58 : C---------------------- 59 : C Variables en COMMON : 60 : C---------------------- 61 : C 62 : C NBCOUL : Nombre de couleurs admises par CASTEM (in CCGEOME) 63 : C NCOUL : Tableau de CHAR*4, dim NBCOUL, Noms des couleurs (in CCGEOME) 64 : C IDCOUL : Valeur de la couleurs par défaut (in CCOPTIO) 65 : C IERR : Numéro de l'erreur détectée (in CCOPTIO) 66 : C IFOUR : Indique le type de calcul (in CCOPTIO) 67 : C NIFOUR : Numéro de l'harmonique de fourier si IFOUR=1 (cf CCOPTIO) 68 : C TITREE : CHAR*72, titre des tracés (cf CCOPTIO) 69 : C 70 : C----------------------------------------------------------------------- 71 : C 72 : C Langage : ESOPE + FORTRAN77 73 : C 74 : C Modifs : F.DABBENE 06/95 (Extension LISTREEL et CHAMPOINT) 75 : C Modifs : S.PASCAL 06/06 (Extension distribution de Poisson) 76 : C 77 : C----------------------------------------------------------------------- 78 : C 79 : IMPLICIT INTEGER(I-N) 80 : IMPLICIT REAL*8(A-H,O-Z) 81 : C 82 : -INC CCGEOME 83 : -INC CCOPTIO 84 : -INC SMEVOLL 85 : -INC SMLENTI 86 : -INC SMLREEL 87 : -INC SMCHPOI 88 : -INC SMELEME 89 : C 90 : CHARACTER*4 MOTYP(4),MOTB(1) 91 : C 92 : DATA MOTB /'BLAN'/ 93 : DATA MOTYP /'GAUS','UNIF','EXPO','POIS'/ 94 : C 95 : C- Lecture du type de bruit 96 : C 96 : CALL LIRMOT(MOTB,1,IVAL,1) 97 : IF (IVAL.EQ.0) RETURN 98 : C 99 : C- Lecture du type de distribution 100 : C 100 : CALL LIRMOT(MOTYP,4,IVAB,1) 101 : IF (IVAB.EQ.0) RETURN 102 : C 103 : C- Lecture de la moyenne et de l'écart type 104 : C 105 : IF (IVAB.EQ.4) THEN 105 : CALL LIRENT(NMOYE,1,IRET1) 106 : IF (IERR.NE.0) RETURN 107 : ELSE 107 : CALL LIRREE(VMOYE,1,IRET1) 108 : IF (IERR.NE.0) RETURN 108 : CALL LIRREE(ECAR,1,IRET1) 109 : IF (IERR.NE.0) RETURN 110 : IF (IVAB.EQ.3) THEN 111 : REAERR(1) = REAL(VMOYE) 111 : CALL ERREUR(-304) 112 : VMOYE = 0.D0 113 : ENDIF 114 : IF (ECAR.LE.0.D0) THEN 115 : REAERR(1) = REAL(0.D0) 116 : REAERR(2) = REAL(ECAR) 116 : CALL ERREUR(191) 117 : RETURN 118 : ENDIF 119 : ENDIF 120 : C 121 : C- Lecture d'un LISTREEL, d'un MELEME ou d'un ENTIER 122 : C 122 : CALL LIROBJ('LISTREEL',IPT1,0,IRET1) 123 : IF (IERR.NE.0) RETURN 124 : IK1 = 0 125 : IF (IRET1.EQ.0) THEN 125 : CALL LIROBJ('MAILLAGE',IPT1,0,IRET1) 126 : IF (IERR.NE.0) RETURN 127 : IK1 = 1 128 : ENDIF 129 : IF (IRET1.EQ.0) THEN 129 : CALL LIRENT(IPT1,1,IRET1) 130 : IF (IERR.NE.0) RETURN 131 : IK1 = 2 132 : ENDIF 133 : C 134 : C- Lecture facultative pour l'initialisation du générateur 135 : C 135 : CALL LIRENT(NSTRT,0,IRET1) 136 : IF (IRET1.EQ.0) THEN 137 : NSTRT = 0 138 : ELSEIF (NSTRT.LT.0) THEN 139 : INTERR(1) = 0 140 : INTERR(2) = NSTRT 140 : CALL ERREUR(190) 141 : RETURN 142 : ENDIF 143 : C 144 : C- Lecture facultative de la couleur si RES1 est une évolution 145 : C 146 : IF (IK1.EQ.0) THEN 146 : CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0) 147 : IF (ICOUL.EQ.0) ICOUL=IDCOUL+1 148 : ICOUL=ICOUL-1 149 : ENDIF 150 : C 151 : C------------------------------------------ 152 : C Génération du LISTREEL de NPTBLO valeurs 153 : C------------------------------------------ 154 : C 155 : C- Initialisation de NPTBLO, nombre de valeurs à générer. 156 : C- Les éléments du MELEME sont transformés en POI1 si nécessaire. 157 : C- Le maillage de pointeur IPT1 est ACTIF en sortie de CHANGE. 158 : C 159 : IF (IK1.EQ.0) THEN 160 : MLREEL = IPT1 161 : SEGACT MLREEL 162 : NPTBLO = PROG(/1) 163 : SEGDES MLREEL 164 : ELSEIF (IK1.EQ.1) THEN 165 : MELEME = IPT1 166 : SEGACT MELEME 167 : NBSOUS = LISOUS(/1) 168 : IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN 168 : CALL CHANGE(IPT1,1) 169 : IF (IERR.NE.0) RETURN 170 : MELEME = IPT1 171 : ENDIF 172 : NPTBLO = NUM(/2) 173 : SEGDES MELEME 174 : ELSE 175 : NPTBLO = IPT1 176 : ENDIF 177 : C 178 : C- Création du LISTREEL ou du LISTENTI qui va contenir les valeurs 179 : C- créées. 180 : C 181 : JG = NPTBLO 182 : IF (IVAB.EQ.4) THEN 183 : SEGINI MLENTI 184 : ELSE 185 : SEGINI MLREEL 186 : ENDIF 187 : C 188 : C- Initialisation du générateur TDRAND 189 : C 190 : DO 10 I=1,NSTRT 190 : CALL TDRAND(XRAN) 191 : 10 CONTINUE 192 : C 193 : C- Génération du bruit selon le type de loi repéré par IVAB 194 : C- 1 - Distribution Gaussienne 195 : C- 2 - Distribution Uniforme 196 : C- 3 - Distribution Exponentielle 197 : C- 4 - Distribution de Poisson 198 : C 199 : IF (IVAB.EQ.1) THEN 200 : DO 20 I=1,NPTBLO 201 : AK = ECAR 201 : CALL TDRAND(XRAN) 202 : IF (XRAN.GT.0.5D0) THEN 203 : AK = -ECAR 204 : XRAN = 1.D0 - XRAN 205 : ENDIF 206 : IF (XRAN.LT.1.D-6) XRAN=1.D-6 207 : T = SQRT( LOG(1.D0 / (XRAN*XRAN)) ) 208 : YY = VMOYE + AK * ( T - (2.30753D0 + 0.27061D0*T) / 209 : # (1.0D0 + T * (0.99229D0 + 0.04481D0*T))) 210 : PROG(I) = YY 211 : 20 CONTINUE 212 : ELSEIF (IVAB.EQ.2) THEN 213 : DO 30 I=1,NPTBLO 213 : CALL TDRAND(XRAN) 214 : YY =VMOYE + (XRAN - 0.5D0) * 2.D0 * ECAR 215 : PROG(I)=YY 216 : 30 CONTINUE 217 : ELSEIF (IVAB.EQ.3) THEN 218 : DO 40 I=1,NPTBLO 218 : CALL TDRAND(XRAN) 219 : IF (XRAN.LT.1.D-6) XRAN = 1.D-6 220 : YY = -LOG(XRAN) * ECAR 221 : PROG(I)= YY 222 : 40 CONTINUE 223 : ELSE 224 : C Pour generer des variables selon une distrib. de Poisson, on emploi 2 225 : C methodes differentes selon que la moyenne de la distrib. est sup. ou 226 : C non a la valeur 50 : 227 : C - Si sup. a 50 : approximation par une gaussienne ; 228 : C - Sinon : methode directe. 229 : XMOYE=FLOAT(NMOYE) 230 : IF (NMOYE.GE.50) THEN 231 : DO 50 I=1,NPTBLO 232 : AK = DSQRT(XMOYE) 232 : CALL TDRAND(XRAN) 233 : IF (XRAN.GT.0.5D0) THEN 234 : AK = -1.D0*AK 235 : XRAN = 1.D0 - XRAN 236 : ENDIF 237 : IF (XRAN.LT.1.D-6) XRAN=1.D-6 238 : T = SQRT( LOG(1.D0 / (XRAN*XRAN)) ) 239 : YY = XMOYE + AK * ( T - (2.30753D0 + 0.27061D0*T) / 240 : # (1.0D0 + T * (0.99229D0 + 0.04481D0*T))) 241 : LECT(I) = INT(YY) 242 : 50 CONTINUE 243 : ELSE 244 : XMOYE = DEXP(-1.D0*XMOYE) 245 : DO 60 I=1,NPTBLO 245 : CALL TDRAND(XRAN) 246 : A=XRAN 247 : DO 61 J=1,(10*NPTBLO) 247 : CALL TDRAND(XRAN) 248 : A=A*XRAN 249 : IF (A.LT.XMOYE) THEN 250 : LECT(I) = J 251 : GOTO 60 252 : ENDIF 253 : 61 CONTINUE 254 : 60 CONTINUE 255 : ENDIF 256 : ENDIF 257 : C 258 : IF (IVAB.EQ.4) THEN 259 : SEGDES MLENTI 260 : ELSE 261 : SEGDES MLREEL 262 : ENDIF 263 : C 264 : C- Création des objets EVOLUTION, CHAMPOINT, LISTREEL ou LISTENTI 265 : C 266 : IF (IK1.EQ.0) THEN 267 : N = 1 268 : SEGINI MEVOLL 269 : IEVTEX = TITREE 270 : ITYEVO = 'REEL' 271 : SEGINI KEVOLL 272 : KEVTEX = TITREE 273 : IEVOLL(1) = KEVOLL 274 : NUMEVX = ICOUL 275 : NUMEVY = 'REEL' 276 : TYPX = 'LISTREEL' 277 : TYPY = 'LISTREEL' 278 : IPROGX = IPT1 279 : NOMEVX = 'TEMPS' 280 : IPROGY = MLREEL 281 : NOMEVY = 'SIGNAL' 282 : SEGDES KEVOLL,MEVOLL 282 : CALL ECROBJ('EVOLUTIO',MEVOLL) 283 : ELSEIF (IK1.EQ.1) THEN 284 : NAT = 1 285 : NSOUPO = 1 286 : SEGINI MCHPOI 287 : MTYPOI = ' ' 288 : MOCHDE = ' ' 289 : JATTRI(1) = 2 290 : IFOPOI = IFOUR 291 : NC = 1 292 : SEGINI MSOUPO 293 : IPCHP(1) = MSOUPO 294 : NOCOMP(1) = 'SCAL' 295 : IGEOC = MELEME 296 : NOHARM(1) = NIFOUR 297 : N = NPTBLO 298 : SEGINI MPOVAL 299 : IPOVAL = MPOVAL 300 : SEGACT MLREEL 301 : DO 70 I=1,NPTBLO 302 : VPOCHA(I,1) = PROG(I) 303 : 70 CONTINUE 304 : SEGSUP MLREEL 305 : SEGDES MPOVAL,MSOUPO,MCHPOI 305 : CALL ECROBJ('CHPOINT',MCHPOI) 306 : ELSE 307 : IF (IVAB.EQ.4) THEN 307 : CALL ECROBJ('LISTENTI',MLENTI) 308 : ELSE 308 : CALL ECROBJ('LISTREEL',MLREEL) 309 : ENDIF 310 : ENDIF 311 : C 312 : RETURN 313 : END 314 : 315 :
© Cast3M 2003 - All rights reserved.
Disclaimer