Télécharger brui.eso

Retour à la liste

Numérotation des lignes :

  1. C BRUI SOURCE CB215821 19/07/31 21:15:34 10277
  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.  
  84. -INC PPARAM
  85. -INC CCOPTIO
  86. -INC SMEVOLL
  87. -INC SMLENTI
  88. -INC SMLREEL
  89. -INC SMCHPOI
  90. -INC SMELEME
  91. C
  92. CHARACTER*4 MOTYP(4),MOTB(1)
  93. C
  94. DATA MOTB /'BLAN'/
  95. DATA MOTYP /'GAUS','UNIF','EXPO','POIS'/
  96. C
  97. C- Lecture du type de bruit
  98. C
  99. CALL LIRMOT(MOTB,1,IVAL,1)
  100. IF (IVAL.EQ.0) RETURN
  101. C
  102. C- Lecture du type de distribution
  103. C
  104. CALL LIRMOT(MOTYP,4,IVAB,1)
  105. IF (IVAB.EQ.0) RETURN
  106. C
  107. C- Lecture de la moyenne et de l'écart type
  108. C
  109. IF (IVAB.EQ.4) THEN
  110. CALL LIRENT(NMOYE,1,IRET1)
  111. IF (IERR.NE.0) RETURN
  112. ELSE
  113. CALL LIRREE(VMOYE,1,IRET1)
  114. IF (IERR.NE.0) RETURN
  115. CALL LIRREE(ECAR,1,IRET1)
  116. IF (IERR.NE.0) RETURN
  117. IF (IVAB.EQ.3) THEN
  118. REAERR(1) = REAL(VMOYE)
  119. CALL ERREUR(-304)
  120. VMOYE = 0.D0
  121. ENDIF
  122. IF (ECAR.LE.0.D0) THEN
  123. REAERR(1) = REAL(0.D0)
  124. REAERR(2) = REAL(ECAR)
  125. CALL ERREUR(191)
  126. RETURN
  127. ENDIF
  128. ENDIF
  129. C
  130. C- Lecture d'un LISTREEL, d'un MELEME ou d'un ENTIER
  131. C
  132. CALL LIROBJ('LISTREEL',IPT1,0,IRET1)
  133. IF (IERR.NE.0) RETURN
  134. IK1 = 0
  135. IF (IRET1.EQ.0) THEN
  136. CALL LIROBJ('MAILLAGE',IPT1,0,IRET1)
  137. IF (IERR.NE.0) RETURN
  138. IK1 = 1
  139. ENDIF
  140. IF (IRET1.EQ.0) THEN
  141. CALL LIRENT(IPT1,1,IRET1)
  142. IF (IERR.NE.0) RETURN
  143. IK1 = 2
  144. ENDIF
  145. C
  146. C- Lecture facultative pour l'initialisation du générateur
  147. C
  148. CALL LIRENT(NSTRT,0,IRET1)
  149. IF (IRET1.EQ.0) THEN
  150. NSTRT = 0
  151. ELSEIF (NSTRT.LT.0) THEN
  152. INTERR(1) = 0
  153. INTERR(2) = NSTRT
  154. CALL ERREUR(190)
  155. RETURN
  156. ENDIF
  157. C
  158. C- Lecture facultative de la couleur si RES1 est une évolution
  159. C
  160. IF (IK1.EQ.0) THEN
  161. CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0)
  162. IF (ICOUL.EQ.0) ICOUL=IDCOUL+1
  163. ICOUL=ICOUL-1
  164. ENDIF
  165. C
  166. C------------------------------------------
  167. C Génération du LISTREEL de NPTBLO valeurs
  168. C------------------------------------------
  169. C
  170. C- Initialisation de NPTBLO, nombre de valeurs à générer.
  171. C- Les éléments du MELEME sont transformés en POI1 si nécessaire.
  172. C- Le maillage de pointeur IPT1 est ACTIF en sortie de CHANGE.
  173. C
  174. IF (IK1.EQ.0) THEN
  175. MLREEL = IPT1
  176. SEGACT MLREEL
  177. NPTBLO = PROG(/1)
  178. SEGDES MLREEL
  179. ELSEIF (IK1.EQ.1) THEN
  180. MELEME = IPT1
  181. SEGACT MELEME
  182. NBSOUS = LISOUS(/1)
  183. IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN
  184. CALL CHANGE(IPT1,1)
  185. IF (IERR.NE.0) RETURN
  186. MELEME = IPT1
  187. ENDIF
  188. NPTBLO = NUM(/2)
  189. SEGDES MELEME
  190. ELSE
  191. NPTBLO = IPT1
  192. ENDIF
  193. C
  194. C- Création du LISTREEL ou du LISTENTI qui va contenir les valeurs
  195. C- créées.
  196. C
  197. JG = NPTBLO
  198. IF (JG .GE. 0) THEN
  199. IF (IVAB.EQ.4) THEN
  200. SEGINI MLENTI
  201. ELSE
  202. SEGINI MLREEL
  203. ENDIF
  204. ELSE
  205. C Cas ou la taille donnee est negative
  206. INTERR = NPTBLO
  207. CALL ERREUR(36)
  208. RETURN
  209. ENDIF
  210. C
  211. C- Initialisation du générateur TDRAND
  212. C
  213. DO 10 I=1,NSTRT
  214. CALL TDRAND(XRAN)
  215. 10 CONTINUE
  216. C
  217. C- Génération du bruit selon le type de loi repéré par IVAB
  218. C- 1 - Distribution Gaussienne
  219. C- 2 - Distribution Uniforme
  220. C- 3 - Distribution Exponentielle
  221. C- 4 - Distribution de Poisson
  222. C
  223. IF (IVAB.EQ.1) THEN
  224. DO 20 I=1,NPTBLO
  225. AK = ECAR
  226. CALL TDRAND(XRAN)
  227. IF (XRAN.GT.0.5D0) THEN
  228. AK = -ECAR
  229. XRAN = 1.D0 - XRAN
  230. ENDIF
  231. IF (XRAN.LT.1.D-6) XRAN=1.D-6
  232. T = SQRT( LOG(1.D0 / (XRAN*XRAN)) )
  233. YY = VMOYE + AK * ( T - (2.30753D0 + 0.27061D0*T) /
  234. # (1.0D0 + T * (0.99229D0 + 0.04481D0*T)))
  235. PROG(I) = YY
  236. 20 CONTINUE
  237. ELSEIF (IVAB.EQ.2) THEN
  238. DO 30 I=1,NPTBLO
  239. CALL TDRAND(XRAN)
  240. YY =VMOYE + (XRAN - 0.5D0) * 2.D0 * ECAR
  241. PROG(I)=YY
  242. 30 CONTINUE
  243. ELSEIF (IVAB.EQ.3) THEN
  244. DO 40 I=1,NPTBLO
  245. CALL TDRAND(XRAN)
  246. IF (XRAN.LT.1.D-6) XRAN = 1.D-6
  247. YY = -LOG(XRAN) * ECAR
  248. PROG(I)= YY
  249. 40 CONTINUE
  250. ELSE
  251. C Pour generer des variables selon une distrib. de Poisson, on emploi 2
  252. C methodes differentes selon que la moyenne de la distrib. est sup. ou
  253. C non a la valeur 50 :
  254. C - Si sup. a 50 : approximation par une gaussienne ;
  255. C - Sinon : methode directe.
  256. XMOYE=FLOAT(NMOYE)
  257. IF (NMOYE.GE.50) THEN
  258. DO 50 I=1,NPTBLO
  259. AK = SQRT(XMOYE)
  260. CALL TDRAND(XRAN)
  261. IF (XRAN.GT.0.5D0) THEN
  262. AK = -1.D0*AK
  263. XRAN = 1.D0 - XRAN
  264. ENDIF
  265. IF (XRAN.LT.1.D-6) XRAN=1.D-6
  266. T = SQRT( LOG(1.D0 / (XRAN*XRAN)) )
  267. YY = XMOYE + AK * ( T - (2.30753D0 + 0.27061D0*T) /
  268. # (1.0D0 + T * (0.99229D0 + 0.04481D0*T)))
  269. LECT(I) = INT(YY)
  270. 50 CONTINUE
  271. ELSE
  272. XMOYE = EXP(-1.D0*XMOYE)
  273. DO 60 I=1,NPTBLO
  274. CALL TDRAND(XRAN)
  275. A=XRAN
  276. DO 61 J=1,(10*NPTBLO)
  277. CALL TDRAND(XRAN)
  278. A=A*XRAN
  279. IF (A.LT.XMOYE) THEN
  280. LECT(I) = J
  281. GOTO 60
  282. ENDIF
  283. 61 CONTINUE
  284. 60 CONTINUE
  285. ENDIF
  286. ENDIF
  287. C
  288. IF (IVAB.EQ.4) THEN
  289. SEGDES MLENTI
  290. ELSE
  291. SEGDES MLREEL
  292. ENDIF
  293. C
  294. C- Création des objets EVOLUTION, CHAMPOINT, LISTREEL ou LISTENTI
  295. C
  296. IF (IK1.EQ.0) THEN
  297. N = 1
  298. SEGINI MEVOLL
  299. IEVTEX = TITREE
  300. ITYEVO = 'REEL'
  301. SEGINI KEVOLL
  302. KEVTEX = TITREE
  303. IEVOLL(1) = KEVOLL
  304. NUMEVX = ICOUL
  305. NUMEVY = 'REEL'
  306. TYPX = 'LISTREEL'
  307. TYPY = 'LISTREEL'
  308. IPROGX = IPT1
  309. NOMEVX = 'TEMPS'
  310. IPROGY = MLREEL
  311. NOMEVY = 'SIGNAL'
  312. SEGDES KEVOLL,MEVOLL
  313. CALL ECROBJ('EVOLUTIO',MEVOLL)
  314. ELSEIF (IK1.EQ.1) THEN
  315. NAT = 1
  316. NSOUPO = 1
  317. SEGINI MCHPOI
  318. MTYPOI = ' '
  319. MOCHDE = ' '
  320. JATTRI(1) = 2
  321. IFOPOI = IFOUR
  322. NC = 1
  323. SEGINI MSOUPO
  324. IPCHP(1) = MSOUPO
  325. NOCOMP(1) = 'SCAL'
  326. IGEOC = MELEME
  327. NOHARM(1) = NIFOUR
  328. N = NPTBLO
  329. SEGINI MPOVAL
  330. IPOVAL = MPOVAL
  331. SEGACT MLREEL
  332. DO 70 I=1,NPTBLO
  333. VPOCHA(I,1) = PROG(I)
  334. 70 CONTINUE
  335. SEGSUP MLREEL
  336. CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  337. CALL ECROBJ('CHPOINT ',MCHPOI)
  338. ELSE
  339. IF (IVAB.EQ.4) THEN
  340. CALL ECROBJ('LISTENTI',MLENTI)
  341. ELSE
  342. CALL ECROBJ('LISTREEL',MLREEL)
  343. ENDIF
  344. ENDIF
  345. C
  346. END
  347.  
  348.  
  349.  

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