tirb.f [SRC] [CPP] [JOB] [SCAN]
srcresultats/00benedicte/.xvpics [=]
resultats/pt1_complet/.xvpics [=]
archivage/code2000X_testCG [=]
resultats/pt1_complet [=]



   1 |        subroutine tirb(p,numbande)
   2 | c.......................................................................
   3 | c     anciennement ntir
   4 | c     distribution d'un nombre de paquets a tirer sur les bandes
   5 | c     en fonction d'une probabilite
   6 | c
   7 | c     tirage du numero numbande conformement a la proba discrete p
   8 | c
   9 | c
  10 | c.......................................................................
  11 | c
  12 | c  in :  * probabilites (une fonction == vecteur)    ---> p(nband_mx)
  13 | c
  14 | c  out : * numero de la bande tiree bande            ---> numbande
  15 | c
  16 | c.......................................................................
  17 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  18 |       IMPLICIT NONE
  19 | c.......................................................................
  20 |       include 'cecile.inc'
  21 | c     cecile.inc sert a la declaration de ngaz_mx
  22 |       INCLUDE 'propradia.inc'
  23 | c.......................................................................
  24 |       DOUBLE PRECISION p(nbande_mx)
  25 | c.......................................................................
  26 |       DOUBLE PRECISION sp(nbande_mx)
  27 | c.......................................................................
  28 |       DOUBLE PRECISION tmp1
  29 |       INTEGER itmp1,itmp2,itmp3,ibandeloc, numbande
  30 | c.......................................................................
  31 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  32 | c construction de la fonction de repartition discrete de p ==> sp
  33 | 
  34 |       sp(1)=p(1)
  35 |       DO ibandeloc=2,nbande
  36 |         sp(ibandeloc)=sp(ibandeloc-1)+p(ibandeloc)
  37 |       ENDDO
  38 | 
  39 | c tirage avec sp pour trouver numbande
  40 |       call rand_uniforme(tmp1)
  41 |       itmp1=0
  42 |       itmp2=nbande+1
  43 | 10000 CONTINUE
  44 |       IF (itmp2-itmp1.GT.1) THEN
  45 |           itmp3=(itmp2+itmp1)/2
  46 |           IF (tmp1.GT.sp(itmp3)) THEN
  47 |             itmp1=itmp3
  48 |           ELSE
  49 |             itmp2=itmp3
  50 |           ENDIF
  51 |       GOTO 10000
  52 |       ENDIF
  53 |       numbande=itmp1+1
  54 | 
  55 | c modif du poids
  56 | c aucune precaution si p(numbande est nul)
  57 |       poids = poids / (nbande*p(numbande))
  58 | c      if (in.eq. 110) then
  59 | c         print *, 'poids, nbande, p(numbande)'
  60 | c         print *, poids, nbande, p(numbande)
  61 | c         read *
  62 | c         endif
  63 |      
  64 | c.......................................................................
  65 |       RETURN
  66 |       END


tirb.f could be called by:
genere_b.f [archivage/code2000X_testCG] - 121
genere_b.f [resultats/pt1_complet] - 121
genere_b.f [src] - 121
testtirb.f [archivage/code2000X_testCG] - 31
testtirb.f [resultats/pt1_complet] - 31
testtirb.f [src] - 31