c=======================================================================

      subroutine volmix(zz,vfn2,vfo2,vfco2,vfch4,vfn2o,vfco, 1
     &                  vfno2,vfso2,vfnh3,vfno,vfhno3)
c
c   called by module absint
c
c volume fractions in ppm
c   input:   z         altitude in km
c
c   output:  vf??      volume fraction of atmospheric specie in ppm
c                      the volume fractions are based on LOWTRAN's 
c                      US standard atmosphere, 1976 
c
c
c***************************************************************
      parameter (mz=33)
      real alt(mz),n2(mz),o2(mz),co2(mz),ch4(mz),n2o(mz),co(mz),
     &     no2(mz),so2(mz),nh3(mz),no(mz),hno3(mz)

      data alt/
     &    0.0,  1.0,  2.0,  3.0, 4.0,   5.0,  6.0,  7.0,  8.0,  9.0,
     &   10.0, 11.0, 12.0, 13.0, 14.0, 15.0, 16.0, 17.0, 18.0, 19.0,
     &   20.0, 21.0, 22.0, 23.0, 24.0, 25.0, 30.0, 35.0, 40.0, 45.0,
     &   50.0, 70.0,100.0/
      data n2/
     &  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,
     &  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,
     &  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,
     &  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,
     &  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,
     &  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,  7.81e+05,
     &  7.81e+05,  7.81e+05,  7.77e+05/
      data o2/
     & 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05,
     & 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05,
     & 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05,
     & 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05,
     & 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05,
     & 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05, 2.090e+05,
     & 2.090e+05, 2.090e+05, 1.600e+05/

c Keeling Mouna Loa CO2 as of jan96

      data co2/
     & 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02,
     & 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02,
     & 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02,
     & 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02,
     & 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02,
     & 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02, 3.600e+02,
     & 3.600e+02, 3.600e+02, 2.130e+02/
      data  ch4/
     & 1.700e+00, 1.700e+00, 1.700e+00, 1.700e+00, 1.700e+00,
     & 1.700e+00, 1.700e+00, 1.699e+00, 1.697e+00, 1.693e+00,
     & 1.685e+00, 1.675e+00, 1.662e+00, 1.645e+00, 1.626e+00,
     & 1.605e+00, 1.582e+00, 1.553e+00, 1.521e+00, 1.480e+00,
     & 1.424e+00, 1.355e+00, 1.272e+00, 1.191e+00, 1.118e+00,
     & 1.055e+00, 9.136e-01, 7.460e-01, 5.638e-01, 3.631e-01,
     & 2.100e-01, 1.500e-01, 1.200e-01/
      data  n2o/
     & 3.200e-01, 3.200e-01, 3.200e-01, 3.200e-01, 3.200e-01,
     & 3.200e-01, 3.200e-01, 3.200e-01, 3.200e-01, 3.195e-01,
     & 3.179e-01, 3.140e-01, 3.095e-01, 3.048e-01, 2.999e-01,
     & 2.944e-01, 2.877e-01, 2.783e-01, 2.671e-01, 2.527e-01,
     & 2.365e-01, 2.194e-01, 2.051e-01, 1.967e-01, 1.875e-01,
     & 1.756e-01, 1.416e-01, 9.275e-02, 4.513e-02, 1.591e-02,
     & 4.752e-03, 1.149e-03, 3.323e-04/
      data co/
     & 1.500e-01, 1.450e-01, 1.399e-01, 1.349e-01, 1.312e-01,
     & 1.303e-01, 1.288e-01, 1.247e-01, 1.185e-01, 1.094e-01,
     & 9.962e-02, 8.964e-02, 7.814e-02, 6.374e-02, 5.025e-02,
     & 3.941e-02, 3.069e-02, 2.489e-02, 1.966e-02, 1.549e-02,
     & 1.331e-02, 1.232e-02, 1.232e-02, 1.307e-02, 1.400e-02,
     & 1.498e-02, 1.710e-02, 2.009e-02, 2.497e-02, 3.241e-02,
     & 4.597e-02, 3.059e-01, 1.692e+01/
      data no2/
     &  2.30e-05,  2.30e-05,  2.30e-05,  2.30e-05,  2.30e-05,
     &  2.30e-05,  2.30e-05,  2.30e-05,  2.30e-05,  2.32e-05,
     &  2.38e-05,  2.62e-05,  3.15e-05,  4.45e-05,  7.48e-05,
     &  1.71e-04,  3.19e-04,  5.19e-04,  7.71e-04,  1.06e-03,
     &  1.39e-03,  1.76e-03,  2.16e-03,  2.58e-03,  3.06e-03,
     &  3.74e-03,  6.16e-03,  7.28e-03,  4.03e-03,  1.15e-03,
     &  4.43e-04,  2.31e-04,  1.70e-04/
      data so2/
     &  3.00e-04,  2.74e-04,  2.36e-04,  1.90e-04,  1.46e-04,
     &  1.18e-04,  9.71e-05,  8.30e-05,  7.21e-05,  6.56e-05,
     &  6.08e-05,  5.79e-05,  5.60e-05,  5.59e-05,  5.64e-05,
     &  5.75e-05,  5.75e-05,  5.37e-05,  4.78e-05,  3.97e-05,
     &  3.19e-05,  2.67e-05,  2.28e-05,  2.07e-05,  1.90e-05,
     &  1.75e-05,  1.34e-05,  1.16e-05,  1.36e-05,  2.10e-05,
     &  3.56e-05,  4.32e-05,  3.58e-07/
      data nh3/
     &  5.00e-04,  5.00e-04,  4.63e-04,  3.80e-04,  2.88e-04,
     &  2.04e-04,  1.46e-04,  9.88e-05,  6.48e-05,  3.77e-05,
     &  2.03e-05,  1.09e-05,  6.30e-06,  3.12e-06,  1.11e-06,
     &  4.47e-07,  2.11e-07,  1.10e-07,  6.70e-08,  3.97e-08,
     &  2.41e-08,  1.92e-08,  1.72e-08,  1.59e-08,  1.44e-08,
     &  1.23e-08,  6.35e-09,  1.82e-09,  2.94e-10,  2.98e-11,
     &  7.13e-12,  2.57e-12,  1.48e-12/
      data no/
     &  3.00e-04,  3.00e-04,  3.00e-04,  3.00e-04,  3.00e-04,
     &  3.00e-04,  3.00e-04,  3.00e-04,  3.00e-04,  3.00e-04,
     &  3.00e-04,  3.00e-04,  3.00e-04,  2.99e-04,  2.95e-04,
     &  2.83e-04,  2.68e-04,  2.52e-04,  2.40e-04,  2.44e-04,
     &  2.55e-04,  2.77e-04,  3.07e-04,  3.60e-04,  4.51e-04,
     &  6.85e-04,  2.45e-03,  7.14e-03,  1.12e-02,  1.17e-02,
     &  1.03e-02,  1.15e-02,  2.08e+00/
      data hno3/
     &  5.00e-05,  5.96e-05,  6.93e-05,  7.91e-05,  8.87e-05,
     &  9.75e-05,  1.11e-04,  1.26e-04,  1.39e-04,  1.53e-04,
     &  1.74e-04,  2.02e-04,  2.41e-04,  2.76e-04,  3.33e-04,
     &  4.52e-04,  7.37e-04,  1.31e-03,  2.11e-03,  3.17e-03,
     &  4.20e-03,  4.94e-03,  5.46e-03,  5.74e-03,  5.84e-03,
     &  5.61e-03,  3.74e-03,  1.64e-03,  5.33e-04,  1.21e-04,
     &  5.55e-05,  3.27e-05,  2.73e-05/

      data un2,uo2,uco2,uch4,un2o,uco,uno2,uso2,unh3,uno,uhno3
     &   /  1., 1.,  1.,  1.,  1., 1.,  1.,  1.,  1., 1., 1./

      data modify/0/
c************************************************************

      z=max(0.,min(zz,100.))

      if(z.lt.25.) then
        k=int(z)+1
      elseif(z.lt.50.) then
        k=26+(z-25.)/5.
      elseif(z.lt.70.) then
        k=31
      elseif(z.le.100.) then
        k=32
      endif

      kp=k+1
      f=(z-alt(k))/(alt(kp)-alt(k))

      vfn2     = n2(k)  * (1.-f) + n2(kp)  * f 
      vfo2     = o2(k)  * (1.-f) + o2(kp)  * f 
      vfco2    = co2(k) * (1.-f) + co2(kp) * f 
      vfch4    = ch4(k) * (1.-f) + ch4(kp) * f 
      vfn2o    = n2o(k) * (1.-f) + n2o(kp) * f 
      vfco     = co(k)  * (1.-f) + co(kp)  * f 
      vfno2    = no2(k) * (1.-f) + no2(kp) * f 
      vfso2    = so2(k) * (1.-f) + so2(kp) * f 
      vfnh3    = nh3(k) * (1.-f) + nh3(kp) * f 
      vfno     = no(k)  * (1.-f) + no(kp)  * f 
      vfhno3   = hno3(k)* (1.-f) + hno3(kp)* f 

      if(modify.eq.1) then
        vfn2     =  vfn2  * un2
        vfo2     =  vfo2  * uo2
        vfco2    =  vfco2 * uco2
        vfch4    =  vfch4 * uch4
        vfn2o    =  vfn2o * un2o
        vfco     =  vfco  * uco
        vfno2    =  vfno2 * uno2
        vfso2    =  vfso2 * uso2
        vfnh3    =  vfnh3 * unh3
        vfno     =  vfno  * uno
        vfhno3   =  vfhno3* uhno3
      endif

c      if(z.lt. .5) then
c        write(*,'(a,/,1p(10e11.3))') 'alt',alt
c        write(*,'(a,/,1p(10e11.3))') 'o2',o2
c        write(*,'(a,/,1p(10e11.3))') 'n2',n2
c        write(*,'(a,/,1p(10e11.3))') 'co2',co2
c      endif
c
c      write(*,'(a,1p(10e11.3))') 'alt,o2,n2,co2 ',z,vfo2,vfn2,vfco2

      return
      
      entry modmix(xn2,xo2,xco2,xch4,xn2o,xco,xno2,xso2,xnh3,xno,xhno3)
c
c modify values of un2 uo2 uco2 uch4 un2o uco uno2 uso2 unh3 uno uhno3
c the values are saved after exit because these variables appear in 
c data statements
c

      if(xn2  .ge. 0. )  un2  = xn2  / n2(1)   
      if(xo2  .ge. 0. )  uo2  = xo2  / o2(1)   
      if(xco2 .ge. 0. )  uco2 = xco2 / co2(1)  
      if(xch4 .ge. 0. )  uch4 = xch4 / ch4(1)  
      if(xn2o .ge. 0. )  un2o = xn2o / n2o(1)  
      if(xco  .ge. 0. )  uco  = xco  / co(1)   
      if(xno2 .ge. 0. )  uno2 = xno2 / no2(1)  
      if(xso2 .ge. 0. )  uso2 = xso2 / so2(1)  
      if(xnh3 .ge. 0. )  unh3 = xnh3 / nh3(1)  
      if(xno  .ge. 0. )  uno  = xno  / no(1)   
      if(xhno3.ge. 0. )  uhno3= xhno3/ hno3(1) 

      test=max(xn2,xo2,xco2,xch4,xn2o,xco,xno2,xso2,xnh3,xno,xhno3)

      if(test .gt. -0.99) modify=1

c 1    format(a,1p11e11.3)
c      write(*,1) 'x',xn2,xo2,xco2,xch4,xn2o,xco,xno2,xso2,xnh3,xno,xhno3
c      write(*,1) 'u',un2,uo2,uco2,uch4,un2o,uco,uno2,uso2,unh3,uno,uhno3

      return
      end