1 | ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
   2 | c     CE SOUS_PROG SELECTIONNE LA LOI DE PROBA LA MIEUX ADAPTEE POUR TIRER LES
   3 | c     BANDES.
   4 | c     Comme la loi de tirage est discrete: le tirage d'une bande etroite
   5 | c     a de fortes chances de se reproduire.
   6 | c     Dans ce cas on peut eviter de refaire des calculs: il fau donc tester par
   7 | c     une variable memoire si la bande a deja ete tiree.
   8 | c     Ce test doit etre effectuer dans une boucle superieure
   9 | c
  10 | c     les cas: 1 emission de paroi
  11 | c              2 emission de volume
  12 | c     option bande: True on optimise tirage
  13 | c                   False on tire plat
  14 | c
  15 | c     out --> ibande en common
  16 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  17 |       subroutine genere_b(cas,opt_bande, vide, proba,tran,total)
  18 | 
  19 | 
  20 | c     declaration par module
  21 | c     neant
  22 | 
  23 | 
  24 |       implicit none
  25 | c     declaration indirecte
  26 |       include 'cecile.inc'
  27 | c     pour ngaz_mx on a cecile.inc car utilise dans propradia.inc
  28 |       include 'propradia.inc'
  29 | c     declaration directe
  30 |       integer cas,toto,total
  31 |       double precision p(1:nbande_mx), proba(1:nbande_mx)
  32 |       double precision tran(1:nbande_mx),cumul
  33 |       logical opt_bande, vide
  34 | 
  35 | 
  36 | 
  37 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  38 | cc DETERMINATION DE LA Fonc DENSITE DE PROBA avec laquelle on va tirer la bande
  39 | c     test la nature de la maille volume ou surface
  40 | c------      if (in=0) .or. (in=n+1) then
  41 | c     tirage loi proba a prtir surface pbandes.f
  42 | c-------      else
  43 | c     tirage en volume pbandeg.f
  44 | c--------------      endif
  45 | c =======> p(num bande)
  46 | 
  47 | c pour l'instant equi probable quelque soit maille quelque soit bande
  48 | c --> independant de la geometrie:  ou s
  49 | c --> independant de l'optique: epaisseur...
  50 | c --> independant config T
  51 | 
  52 | 
  53 |      
  54 |       cumul = 0.d+0
  55 |       do ibande=1,nbande
  56 | c         print *, dbmax(ibande)
  57 | c         read *
  58 | c                print *, ibande, taub(1,ibande),taub(2,ibande), 
  59 | c     & taub(3,ibande)
  60 | c    premiere loi de proba utilise  
  61 | cc                p(ibande)= 1./nbande
  62 |            p(ibande) = mtaub(ibande)* dbmax(ibande)
  63 | c     & 1-((taub(1,ibande)*  taub(2,ibande)*taub(3,ibande)
  64 | c     & ))*dbmax(ibande)
  65 | cc           print *,'3:   ', dbmax(ibande), taub(1,ibande)* 
  66 | cc     & taub(2,ibande)*taub(3,ibande)
  67 | cc           print *, taub(1,ibande),taub(2,ibande),taub(3,ibande)
  68 | c           print *, ibande, p(ibande)
  69 |            cumul=cumul +  p(ibande) 
  70 | cc           print *, 'cumul', cumul
  71 | cc           read *
  72 |       enddo
  73 | c      read *
  74 | c     normalisation pour obtenir proba
  75 | ccc      if (in.eq.110) then
  76 | ccc         print *, 'cumul', cumul
  77 | ccc         read *
  78 | ccc         endif
  79 | c	if((in .eq. 0) .or. (in .eq. (n+1))) then
  80 | c		!on tire plat les bandes des parois tjrs
  81 | c		cumul = 0.d+0
  82 | c	endif
  83 |       if ((cumul .eq. 0.d+0).or.(.not. opt_bande).or.(vide)) then
  84 |                do ibande=1,nbande
  85 |                   p(ibande)= 1./nbande
  86 |                   !zero pose des probleme dans tirb ==> /0
  87 |                   !c'est pour ca qu'il y a "vide"
  88 |                   
  89 |                   ! ce changement de loi de proba ne pose pas de Pb
  90 |                   ! car tout est  bien fait dans tirb
  91 |                   ! s'en assurer en telephonant a Richard 30 nov 1999
  92 |                enddo
  93 |          
  94 |             else
  95 | 
  96 |                do ibande=1,nbande
  97 |                   p(ibande)= p(ibande)/cumul
  98 |                   if (in .eq. 60) then
  99 |                   !on conserve le profil de la proba utilisée pour les bandes
 100 |                   !c'est le meme utilise 10000 fois pour une maille emission (60 ici)
 101 |                   proba(ibande) = p(ibande)
 102 |                   endif
 103 |                enddo
 104 |       endif
 105 | c       print *,p
 106 | c       read *
 107 | 
 108 | cc conserver une image de la fonction proba utilise
 109 | c      if ((in.eq.6).and.(itir.eq.1)) then
 110 | c      open(80, file='bande.out', status='unknown')
 111 | c      do ibande=1,nbande
 112 | c         write(80,*) in, itir, ibande, p(ibande)
 113 | c      enddo
 114 | c      close(80)
 115 | c      endif
 116 | cc
 117 | cc TIRAGE d'une BANDE
 118 | c     on genere le numero de la bande
 119 | c     pb a prendre en compte ne pas genere bande ou co2 et h20 transparent ???
 120 | 
 121 |       call tirb(p,ibande)
 122 |       !
 123 |       if (in .eq. 60) then
 124 |          !conserver dans un fichier la statistique des tirage de bandes
 125 |          !!!do toto=1,367
 126 |           !!!  if (ibande .eq. toto) then
 127 |             !on rajoute au compteur de tranche
 128 |             tran(ibande) = tran(ibande) +1
 129 |             !on rajoute compteur total
 130 |             total = total +1
 131 |          !!!   endif
 132 |          !!!enddo
 133 |       endif
 134 |       !
 135 |       !ibande = 140
 136 |       
 137 | 
 138 |       return
 139 |       end
 140 | 
 141 |