1 |         SUBROUTINE modbgaz(ptotale,temp,fmco,fmco2,fmh2o,flag)
   2 | C**********************************************************************
   3 | C
   4 | C   THIS SUBROUTINE calcule les trois parametres du modele de gaz de
   5 | c                   bande etroite pour chacun des gaz sur une maille
   6 | c                   chacun des gaz etant seul: spectres decorelles
   7 | c                   NON on tiens compte de la presence des autre sgaz
   8 | c                   par l'intermediaire de la pression
   9 | c                   ceci reste local:une maille
  10 | c                   AVERTISSEMENT !!!: Directement construit a partir 
  11 | c                                   du programme de Taine et Soufiani
  12 | c                                   subroutine TRSMI
  13 | c
  14 | c     in -->    pression totale (idem dans toutes les mailles)
  15 | c               temperature de la maille
  16 | c               fraction molaire de h20, c02 et co
  17 | c               'profils.inc' mais besoin de 'cecile.inc' car n_mx
  18 | c               donc ci-dessus en entree
  19 | c
  20 | c               les pivots: donnees de Taine 
  21 | c               kgb_piv,  dinv_piv:   'propradia.inc'
  22 | c
  23 | c               la frequence de centrage de la bande etroite tiree
  24 | c               eta      'propradia.inc'  ibande ==> ico etc....
  25 | c               
  26 | c
  27 | c     out -->   les valeurs des trois parametres kgb6p, dinv, gamma 
  28 | c               et phi
  29 | c               'propradiabis.inc'
  30 | c               le 1er mars 1999 Amaury
  31 | c               kgb6p en cm-1 chez Taine pour nous converti en m-1
  32 | c               phi est un rapport donc sans unite
  33 | c
  34 | C*********************************************************************
  35 | 
  36 | 
  37 | c     declarations 
  38 |       implicit none
  39 |       include 'cecile.inc'
  40 | c     necessaire a radiatif pour n_mx
  41 | 
  42 |       include 'propradia.inc'
  43 |       include 'propradiabis.inc'
  44 | 
  45 | c     rajouter avec modifs en bas du 21 avril 1999
  46 |       include 'radiatif.inc'
  47 | 
  48 |       integer IT
  49 |       double precision  ptotale
  50 |       double precision	temp, RT, RATT
  51 |       double precision	fmco
  52 |       double precision	fmco2
  53 |       double precision	fmh2o
  54 |       double precision T296, T273, T900, fmn2, GAM
  55 |       double precision XKCO, XKCO2, XKH2O, XDCO,XDCO2, XDH2O 
  56 |       double precision XBCO, XBCO2, XBH2O
  57 | 
  58 |       logical flag
  59 | ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  60 | C***********************************************************
  61 | C                                                          *
  62 | C     CALCULATION OF THE TRANSMISSIVITY OF A INHOMOGENEOUS *
  63 | C     COLUMN WITH CURTIS-GODSON APPROXIMATION              *
  64 | C     TRANSMISSIVITIES ARE CALCULATED BETWEEN THE FIRST    *
  65 | C     POINT AND A CURRENT POINT OF THE COLUMN              *
  66 | C                                                          *
  67 | C***********************************************************
  68 | C
  69 | C
  70 | c      SUBROUTINE TRSMI
  71 | c      IMPLICIT DOUBLE PRECISION (A-C,E-H,O-Z)
  72 | c      REAL KCO,KC,KH
  73 | c      LOGICAL LICO,LICO2,LIH2O
  74 | c      PARAMETER (NMAX=100)
  75 | c      COMMON/PHYS/XD(NMAX),T(NMAX),P(NMAX),XH2O(NMAX),XCO2(NMAX),
  76 | c     .            XCO(NMAX),XSUT(NMAX),N
  77 | c      COMMON /LINDX/LICO,LICO2,LIH2O
  78 | c      COMMON /SPCD/DCO(14,48),DC(14,367),DH(14,367)
  79 | c      COMMON /SPCK/KCO(14,48),KC(14,367),KH(14,367)
  80 | c      COMMON /INDEX/ICO,ICO2,IH2O
  81 | c      COMMON /CFSUT/WV55
  82 | c      COMMON/TAUCOL/TAUIN(NMAX+1)
  83 | c      DIMENSION XKCO(NMAX),XDCO(NMAX),XBCO(NMAX)
  84 | c      DIMENSION XKCO2(NMAX),XDCO2(NMAX),XBCO2(NMAX)
  85 | c      DIMENSION XKH2O(NMAX),XDH2O(NMAX),XBH2O(NMAX)
  86 | c      DIMENSION RRT(NMAX),IIT(NMAX),XH(NMAX)
  87 | 
  88 | 
  89 |       CALL modbgazinterp(temp,RT,IT,flag)
  90 | c      RRT(J)=RT
  91 | c      IIT(J)=IT
  92 | 
  93 | c      mise a zero: pas de bandes d'absorption ou d'emission
  94 | c     bien que le tirage des bandes devra etre oriente sur les
  95 | c     bandes non transparentes, il peut arriver de tomber
  96 | c     la ou c'est vide (surtout pour co et co2 ). Donc il faut
  97 | c     affecter des valeurs par defaut pour les bandes vides.
  98 | c     Amaury le 5 juillet 1999
  99 | 
 100 | c     espace moyen entre les raies (infini)
 101 |       GAM = 1d+10
 102 | 
 103 |       XKCO = 0.
 104 |       XDCO = 1.d+0
 105 |       XBCO = 1.d+0 
 106 | 
 107 |       XKCO2  = 0.
 108 |       XDCO2 = 1.d+0
 109 |       XBCO2 = 1.d+0
 110 | 
 111 |       XKH2O = 0.
 112 |       XDH2O = 1.d+0
 113 |       XBH2O = 1.d+0
 114 |     
 115 | c     test
 116 | c      write (*,*) 'debut modbgaz:  '
 117 | c      write (*,*) 'bande active: bande, co co2 h2o  ', ibande, 
 118 | c     & LICO(ibande), 
 119 | c     & LICO2(ibande), LIH2O(ibande)
 120 | c      print *, 'ibande',ibande
 121 |       T296=296./temp
 122 |       T273=273./temp
 123 |       T900=900./temp
 124 |       fmn2=1.-fmco-fmco2-fmh2o
 125 | 
 126 |       IF(LICO(ibande)) THEN
 127 |         GAM=0.07*fmco2+0.06*(fmco+fmn2+fmh2o)
 128 |         GAM=ptotale*GAM*SQRT(T273)
 129 |         XKCO=kgb_piv(1,IT,ICO(ibande))+RT*(kgb_piv(1,IT+1,
 130 |      &  ICO(ibande))- 
 131 |      &  kgb_piv(1,IT,ICO(ibande)))
 132 |         XDCO=dinv_piv(1,IT,ICO(ibande))+RT*(dinv_piv(1,IT+1,
 133 |      &  ICO(ibande))- 
 134 |      &  dinv_piv(1,IT,ICO(ibande)))
 135 | 
 136 |         XBCO=2.*GAM*XDCO
 137 | 
 138 | c        write (*,*) '____'
 139 | c        write (*,*) XBCO, 2.*GAM*XDCO
 140 | c        write (*,*) '____'
 141 | 
 142 |       ENDIF
 143 |       IF(LICO2(ibande)) THEN
 144 |         GAM=0.07*fmco2+0.058*fmn2+0.15*fmh2o
 145 |         IF(temp.LE.900.) THEN
 146 |         GAM=ptotale*GAM*(T296)**0.7
 147 |         ELSE
 148 |         GAM=ptotale*GAM*0.45913*DSQRT(T900)
 149 |         ENDIF
 150 |         XKCO2=kgb_piv(2,IT,ICO2(ibande))+RT*(kgb_piv(2,IT+1,
 151 |      &  ICO2(ibande))- 
 152 |      &  kgb_piv(2,IT,ICO2(ibande)))
 153 |         XDCO2=dinv_piv(2,IT,ICO2(ibande))+RT*(dinv_piv(2,IT+1,
 154 |      &  ICO2(ibande))- 
 155 |      &  dinv_piv(2,IT,ICO2(ibande)))
 156 | 
 157 |         XBCO2=2.*GAM*XDCO2
 158 |       ENDIF
 159 |       IF(LIH2O(ibande)) THEN
 160 |         RATT=DSQRT(T296)
 161 |         GAM=0.066*(7.0*RATT*fmh2o+1.2*(fmh2o+fmn2)+1.5*fmco2)
 162 |      &  *RATT
 163 |         GAM=ptotale*GAM
 164 |         XKH2O=kgb_piv(3,IT,IH2O(ibande))+RT*(kgb_piv(3,IT+1,
 165 |      &  IH2O(ibande))- 
 166 |      &  kgb_piv(3,IT,IH2O(ibande)))
 167 |         XDH2O=dinv_piv(3,IT,IH2O(ibande))+RT*(dinv_piv(3,IT+1,
 168 |      &  IH2O(ibande))- 
 169 |      &  dinv_piv(3,IT,IH2O(ibande)))
 170 | 
 171 |         XBH2O=2.*GAM*XDH2O
 172 |       ENDIF
 173 |  
 174 |       gamma(1,ibande)=GAM
 175 |       gamma(2,ibande)=GAM
 176 |       gamma(3,ibande)=GAM
 177 | c     conversion en cm-1 vers m-1 : *1d+2
 178 |       kgb6p(1,ibande)=XKCO*1.d+2
 179 |       kgb6p(2,ibande)=XKCO2*1.d+2
 180 |       kgb6p(3,ibande)=XKH2O*1.d+2
 181 | 
 182 |       dinv(1,ibande)=XDCO
 183 |       dinv(2,ibande)=XDCO2
 184 |       dinv(3,ibande)=XDH2O
 185 | 
 186 |       phi(1,ibande)=XBCO
 187 |       phi(2,ibande)=XBCO2
 188 |       phi(3,ibande)=XBH2O
 189 | 
 190 | c ceci a ete rajoute le 21 avril 1999ccccccccccccccccccccccccccc
 191 | 
 192 |       kgbar(1,iin)= kgb6p(1,ibande)*ptotale*fmco
 193 |       kgbar(2,iin)= kgb6p(2,ibande)*ptotale*fmco2
 194 |       kgbar(3,iin)= kgb6p(3,ibande)*ptotale*fmh2o
 195 | 
 196 |       phig(1,iin)=phi(1,ibande)
 197 |       phig(2,iin)=phi(2,ibande)
 198 |       phig(3,iin)=phi(3,ibande)
 199 | c      print *,'modbgaz'
 200 | c      print *, kgbar(2,iin),kgb6p(2,ibande),ptotale,fmco2
 201 | 
 202 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 203 | 
 204 | c      write (*,*) 'Dans mode bgaz'
 205 | c      write (*,*) GAM,  XDCO,'  1er:  ', XBCO,'  2iem: ', 2.*GAM*XDCO
 206 | c      write (*,*)  phi(1,ibande),  phig(1,iin), kgbar(1,iin)
 207 | c      read *
 208 | 
 209 | c      write (*,*) 'Dans mode bgaz'
 210 | c      write (*,*) GAM,  XDCO2,'  1er:  ', XBCO2,'  2iem: ', 2.*GAM*XDCO2
 211 | c      write (*,*)  phi(2,ibande),  phig(2,iin), kgbar(2,iin)
 212 | c      read *
 213 | 
 214 | !      if (phi(3,ibande).ge. 10) then
 215 | !       if (in .eq. 0) then
 216 | !      write (*,*) '----------------------------------------------------'
 217 | !      write (*,*) 'Dans mode bgaz:  iin=', iin
 218 | c      write (*,*) GAM,  XDH2O,'  1er:  ', XBH2O,'  2iem: ', 2.*GAM*XDH2O
 219 | !      write (*,*)  phi(3,ibande),  phig(3,iin),  kgbar(3,iin), 'ibande='
 220 | !     & , ibande, 'GAMMA=', GAM, XDH2O,'*******=', 
 221 | !     & dinv_piv(3,IT,IH2O(ibande))+RT*(dinv_piv(3,IT+1,
 222 | !     &  IH2O(ibande))- 
 223 | !     &  dinv_piv(3,IT,IH2O(ibande))), dinv_piv(3,IT,IH2O(ibande)), RT
 224 | !     & ,(dinv_piv(3,IT+1,IH2O(ibande))) 
 225 | !      read *
 226 | !      write (*,*) '----------------------------------------------------'
 227 | !      endif
 228 | c      print *, (.not. boolspec)
 229 | c          if (.not. boolspec) then
 230 | c           do igaz=1,3
 231 | c             kgbar(igaz,iin) = speckgbar
 232 | c             if (iin.eq.1) then
 233 | c               phig(igaz,iin) = specphi * 2.
 234 | cc               phig(igaz,iin) = specphi
 235 | c             else
 236 | c               phig(igaz,iin) = specphi
 237 | c             endif
 238 | c           enddo
 239 | c           kgbar(1,iin)=0.d+0
 240 | c           kgbar(2,iin)=0.d+0
 241 | c          endif
 242 | 
 243 |             
 244 |       RETURN
 245 |       END
 246 |