Télécharger brui.eso

Retour à la liste

Numérotation des lignes :

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

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