1 | c.......................................................................
   2 | c
   3 | c     calcul de la fonction "correction a la fonctionnelle poids"
   4 | c     pour tenir compte des homogeneites sur le trajet optique
   5 | c     modifiant le parametre de bande PHI (Curtis-Godson part II)
   6 | c     On calcul pdf(CG)/pdf(utilise)= fss(a,phicg)/fss(a/phi)
   7 | c     Il est deja tenu compte des modif de kgbar par kgskgbar(part I)
   8 | c
   9 | c     en entree : * a: k sur kgbar a l'emission (sans unite)
  10 | c                 * kbcg: epaiseur optique totale somme kbar*l
  11 | c                 * phicg: idem mais de Curtis-Godson
  12 | c                 * taub: la somme des kbar * l
  13 | c                 * kbarin: kbar du gaz dans maille d'emission ou sigma1
  14 | c                 * sigma1: longueur chemin dans maille emission
  15 | c
  16 | c                 *kbariin: kbar du gaz dans maille de reception
  17 | c                 *sigma_2: longueur chemin ds maille reception (inutile)
  18 | c                 *phi2: parametre de forme a la reception
  19 | c                 (les "deux" var ci-dessus servent pour CG en vol/vol)
  20 | c
  21 | c     en sortie : * la fonction correction pour un gaz
  22 | c                   a multiplier au poids (correction pdf * alpha)
  23 | c......................................................................
  24 | c     2000 juillet 9: Richard et Amaury
  25 | c     2000 octobre 12: " et " des modifs sur alpha
  26 | c.......................................................................
  27 |       double precision function cg_mix(kbcg,phicg)
  28 | c.......................................................................
  29 | c      implicit double precision (a-h,o-z)
  30 |       implicit none
  31 |       include 'cecile.inc'  ! pout passer la varibale hetero
  32 |       include 'propradia.inc'
  33 |       include 'radiatif.inc'
  34 | 
  35 |       include 'entre.inc'  
  36 |       double precision alpha
  37 |       double precision kbcg(ngaz_mx), phicg(ngaz_mx)
  38 |       double precision diffi(ngaz_mx),diffj(ngaz_mx),diffij(ngaz_mx)
  39 | 
  40 | c.......................................................................
  41 | c      integer in, iin ,ngaz_mx,nbande_mx
  42 | c      double precision a, phi, phicg,kbarin,sigma1
  43 | c      double precision kbariin, sigma2, phi2  !utilise pour vol/vol seul
  44 | c      double precision toto
  45 | c      double precision taub
  46 | c      double precision alpha, beta, df6f, dphicg6dl
  47 | c      double precision phieqtronque  !sans le sigma_1
  48 | ! POUR L4INSTANT UN SEUL GAZ EAU 
  49 |        igaz = 3
  50 | 
  51 |          ! on y va pour curtis-godson
  52 |          ! alpha n'est pas egal a un 
  53 |          !rapport pdf * alpha
  54 |          !rapport pdf * (1-beta)
  55 |          !ATTENTION TROIS BRANCHES
  56 |          if (((in.eq.0).or.(in.eq.(n+1))).and.((iin.eq.0).or.
  57 |      &      (iin.eq.(n+1)))) then
  58 |             !la cas paroi/paroi
  59 |             cg_mix =  1.d+0
  60 |             
  61 | 
  62 |             elseif ((in.eq.0).or.(in.eq.(n+1)).or.(iin.eq.0).or.
  63 |      &      (iin.eq.(n+1))) then
  64 |             !volume-paroi
  65 |             if ((in.eq.0).or.(in.eq.(n+1))) then 
  66 |                  !on derive en iin = j
  67 |                  call d1fds2(kgbar(igaz,iin),kgskgbar(igaz),kbcg(igaz)
  68 | !                  call d1fds2(kgbar(igaz,iin),1.d+0,kbcg(igaz)
  69 | !     &                        ,phicg(igaz),phig(igaz,iin),diffj(igaz))
  70 |      &                        ,phicg(igaz),phig(igaz,iin),diffj(igaz))
  71 | !!!                 alpha = - diffj(igaz)
  72 |                  alpha = diffj(igaz)
  73 |                  cg_mix = 1.d+0  
  74 |      &  - (alpha/(kgbar(igaz,iin)*kgskgbar(igaz)))
  75 |                  if (kgbar(igaz,iin).eq.0.d+0) cg_mix = 1.d+0
  76 |                  !cg_mix = alpha
  77 | 
  78 |                  else
  79 |                  !on derive en in = i
  80 |                  call d1fds1(kgbar(igaz,in),kgskgbar(igaz),kbcg(igaz)
  81 | !                 call d1fds1(kgbar(igaz,in),1.d+0,kbcg(igaz)
  82 | !     &                        ,phicg(igaz), phig(igaz,in),diffi(igaz))
  83 |      &                        ,phicg(igaz),phig(igaz,in),diffi(igaz))
  84 |                  alpha = diffi(igaz)
  85 |                  cg_mix = 1.d+0 
  86 |      &  - (alpha /(kgbar(igaz,in)*kgskgbar(igaz)))
  87 |                  if (kgbar(igaz,iin).eq.0.d+0) cg_mix = 1.d+0                 
  88 |                  !cg_mix = alpha
  89 | 
  90 |             endif
  91 | !!!!!!!!!!!!!!!!!!!!!!!!!            write(21,*) 'Vin  ', ibande,'     ', in, iin,cg_mix !enlever proporadia  
  92 |             else
  93 |             !volume volume
  94 |             call d1fds2(kgbar(igaz,iin),kgskgbar(igaz),kbcg(igaz)
  95 |      &                   ,phicg(igaz),phig(igaz,iin),diffj(igaz))
  96 |             call d1fds1(kgbar(igaz,in),kgskgbar(igaz),kbcg(igaz)
  97 |      &                   ,phicg(igaz),phig(igaz,in),diffi(igaz))
  98 |             call d2fds1ds2(kgbar(igaz,in),kgbar(igaz,iin)
  99 |      &                   ,kgskgbar(igaz),kbcg(igaz)
 100 |      &                   ,phicg(igaz),phig(igaz,in),phig(igaz,iin)
 101 |      &                   ,diffij(igaz))
 102 |             
 103 | 
 104 |             cg_mix = 
 105 |      &   kgbar(igaz,iin)*kgbar(igaz,in)*kgskgbar(igaz)**2
 106 |      &   +kgbar(igaz,iin)*kgskgbar(igaz)**2*diffi(igaz)
 107 |      &   -kgbar(igaz,in)*kgskgbar(igaz)**2*diffj(igaz)
 108 |      &   -kgskgbar(igaz)**2*diffij(igaz)
 109 |             cg_mix = 1.d+0
 110 | 
 111 |          endif
 112 |          !cg_mix = 1.d+0
 113 |          !!write(21,*) in,iin, kgskgbar(igaz),kbcg(igaz),phicg(igaz)
 114 | c.......................................................................
 115 |       return
 116 |       end
 117 | c.......................................................................
 118 | 
 119 | 
 120 | 
 121 |