old.f [SRC] [CPP] [JOB] [SCAN]
debug / oldspectre



   1 |       SUBROUTINE calcparamspect(ptotale,temp,fmh20,fmco2,fmco)
   2 | C*****************************************************************
   3 | C                                                                *
   4 | C   THIS SUBROUTINE calcule le spectre de gaz pour une maille    *
   5 | c                   cad pour des conditions physiques donnees
   6 | c                   cf prog snb de TAine
   7 | c
   8 | c
   9 | c     in -->    pression totale
  10 | c               temperature de la maille
  11 | c               fraction molaire de h20, c02 et co
  12 | c               donnees de taine dans intaine.inc
  13 | c
  14 | c     out-->    definis dans gazsuie.inc
  15 | c               les valeurs interpolees k_g6p //  k_s6fv // phi
  16 | C*****************************************************************
  17 | 
  18 | 
  19 | c declarations
  20 | c      car dans intaine besoin de ngaz_mx ...
  21 | c      l'utilisTION de intaine utilise tjrs gazsuie
  22 |        include 'gazsuie.inc'
  23 |        include 'intaine.inc'
  24 | c      REAL KCO,KC,KH
  25 | c      COMMON /SPCD/DCO(14,48),DC(14,367),DH(14,367)
  26 | c      COMMON /SPCK/KCO(14,48),KC(14,367),KH(14,367)
  27 | c      include gaz.inc avec ajout indice pour nature du gaz
  28 | 
  29 | 
  30 | c..............................................................
  31 |       double precision  ptotale
  32 |       double precision	temp
  33 |       double precision	fmco
  34 |       double precision	fmco2
  35 |       double precision	fmh2o
  36 |  
  37 | c  plus lecture donnees taine: d-1 et kbar
  38 | c      integer itemp_mx
  39 | c      parameter (itemp_mx =14)
  40 | c      double precision  k (ngaz_mx,nbande_mx,ntemp_mx)
  41 | c      double precision  dinv (ngaz_mx,nbande_mx,ntemp_mx) 
  42 | 
  43 | c...............................................................
  44 |       double precision rt
  45 |       integer i,j , it,ibande
  46 | 
  47 | 
  48 | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
  49 | c PARAMETRES DU MODELE GAZ: VALEUR SUR PIVOTS
  50 | c lecture de la structure en bande commune a tous les spectres
  51 | c  moleculaires
  52 |     
  53 | 
  54 |       open(unit=9, file='SNBWN')
  55 | 
  56 | c lecture initial pour boucle conditionnelle     
  57 |       ibande =1 
  58 |       read(9,*) eta(ibande), delta_eta(ibande)
  59 | 
  60 | c lecture boucle     
  61 |       ibande=1
  62 |       do while (eta(ibande).ge.0)
  63 |          read(9,*) eta(ibande+1), delta_eta(ibande+1)
  64 |          ibande=ibande+1
  65 |       enddo
  66 |       nbande =ibande - 1
  67 |       close(9)
  68 | c.......................................................................
  69 | c lecture des donnes du modele de gaz Taine ==> D=1/delta K=kbar
  70 | C
  71 | C
  72 |       call tparam
  73 | 
  74 | 
  75 | 
  76 | 
  77 | c VARIABLES D'ETAT: INTERPOLATION DES PARAMETRES
  78 | c.......................................................................
  79 | c interpolation sur temp pour avoir le spectre sur toutes les bandes
  80 | c a temp etc.....
  81 | C
  82 | C     WAVE NUMBER LOOP
  83 | C
  84 | c      IWVNB=0
  85 | c      OPEN(UNIT=9,FILE='SNBWN')
  86 | c1000  CONTINUE
  87 |       do IWVNB=1,nbande
  88 | 
  89 | c      IWVNB=IWVNB+1
  90 | c      READ(9,*) WVNB,DWVNB
  91 | c      IF(WVNB.LT.0.) GOTO 1001
  92 |       WV55=WVNB*5.5
  93 | c      WV(IWVNB)=WVNB
  94 | 
  95 | C
  96 | C     CALCULATION OF THE SPECTRAL INDEX FOR EACH SPECIES
  97 | C
  98 |       CALL TFINDI
  99 | C
 100 | C     CALCULATION OF BLACKBODY INTENSITIES
 101 | C
 102 |       DO 3 I=1,N
 103 |       TT=T(I)
 104 |       XLUM(I)=XLU(TT)
 105 | 3     CONTINUE
 106 | C
 107 | C     CALCULTATION OF TRANSMISSIVITIES
 108 | C
 109 |       CALL TRSMI
 110 | C
 111 | C     CALCULATION OF RADIATIVE INTENSITIES
 112 | C
 113 |       XL(IWVNB)=0.
 114 |       DO 4 I=1,N
 115 |       XL(IWVNB)=XL(IWVNB)+XLUM(I)*(TAUIN(I)-TAUIN(I+1))
 116 | 4     CONTINUE
 117 |       XLS(IWVNB)=XL(IWVNB)/DWVNB
 118 |       WRITE(11,*) WVNB, TAUIN(N+1)
 119 |       WRITE(10,*) WVNB,XLS(IWVNB)
 120 |       
 121 | c      GOTO 1000
 122 |       enddo
 123 | 
 124 | 
 125 | 
 126 | 
 127 | 
 128 | 
 129 | 
 130 | 
 131 | 
 132 | 
 133 | 
 134 | 
 135 | 
 136 | 
 137 | 
 138 | 
 139 |       call ntno(temp,rt,it)     
 140 | 
 141 | 
 142 | c calcul des gamma
 143 | 
 144 |       NCOL=N+1
 145 |       DO 1 J=1,NCOL-1
 146 |       XH(J)=XD(J)
 147 |       CALL TMNO(T(J),RT,IT)
 148 |       RRT(J)=RT
 149 |       IIT(J)=IT
 150 |       T296=296./T(J)
 151 |       T273=273./T(J)
 152 |       T900=900./T(J)
 153 |       XN2=1 .-XCO(J)-XCO2(J)-XH2O(J)
 154 |       IF(LICO) THEN
 155 |         GAM=0.07*XCO2(J)+0.06*(XCO(J)+XN2+XH2O(J))
 156 |         GAM=P(J)*GAM*SQRT(T273)
 157 |         XKCO(J)=KCO(IT,ICO)+RT*(KCO(IT+1,ICO)-KCO(IT,ICO))
 158 |         XDCO(J)=DCO(IT,ICO)+RT*(DCO(IT+1,ICO)-DCO(IT,ICO))
 159 |         XBCO(J)=2.*GAM*XDCO(J)
 160 |       ENDIF
 161 |       IF(LICO2) THEN
 162 |         GAM=0.07*XCO2(J)+0.058*XN2+0.15*XH2O(J)
 163 |         IF(T(J).LE.900.) THEN
 164 |         GAM=P(J)*GAM*(T296)**0.7
 165 |         ELSE
 166 |         GAM=P(J)*GAM*0.45913*DSQRT(T900)
 167 |         ENDIF
 168 |         XKCO2(J)=KC(IT,ICO2)+RT*(KC(IT+1,ICO2)-KC(IT,ICO2))
 169 |         XDCO2(J)=DC(IT,ICO2)+RT*(DC(IT+1,ICO2)-DC(IT,ICO2))
 170 |         XBCO2(J)=2.*GAM*XDCO2(J)
 171 |       ENDIF
 172 |       IF(LIH2O) THEN
 173 |         RATT=DSQRT(T296)
 174 |         GAM=0.066*(7.0*RATT*XH2O(J)+1.2*(XH2O(J)+XN2)+1.5*XCO2(J))*RATT
 175 |         GAM=P(J)*GAM
 176 |         XKH2O(J)=KH(IT,IH2O)+RT*(KH(IT+1,IH2O)-KH(IT,IH2O))
 177 |         XDH2O(J)=DH(IT,IH2O)+RT*(DH(IT+1,IH2O)-DH(IT,IH2O))
 178 |         XBH2O(J)=2.*GAM*XDH2O(J)
 179 |       ENDIF
 180 | 1     CONTINUE
 181 | 
 182 | 
 183 | 
 184 | 
 185 | 
 186 |       return
 187 |       end