subroutine slant(h,ps,cofx,fracin,lmax,layer,pshold,hhold)
c
c***********************************************************************
cccc
c     subroutine slant
c
c     purpose-
c        1. subdivide the layers of the standard atmosphere and
c           calculate the scattering and total optical depths of the
c           atmosphere from top to each layer.
c        2. using the above results calculate the chapman constants.
c
c     method-
c        1. the layers are subdivided using exponential interpolation
c        2. the total o.d. are calculated using spline interpolation
c
c     calling sequence-
c        call slant(h,ps,cofx,fracin,juzsfr,lmax,layer)
c
c        variable    type  i/o  description
c        --------    ----  ---  -----------
c
c        h(487)      r*8    i   height of the layers above surface(km)
c                           o   height from earth center(fraction of r)
c        ps(487)     r*8    i   pressure at each layer (in atmosphere)
c                           o   rayleigh opt. thickness of each layer
c                               of the standard atmosphere
c        cofx(4,487) r*8    i   spline interpolation coeff.
c        fracin             o   layer*radius of earth(km)
c        juzsfr      i*4    i   print flag
c        lmax        i*4    i   no. of layers in standard atmosphere
c        layer       i*4    i   no. of subdivisions to be made of each
c                               layer of the standard atmosphere
c     other variables are returned thru common  block 'chpmn'
c
c     last modified 03/14/95...dave flittner
c     purpose: set pressure scale height used in gravity correction
c     to rayleigh scattering od.  Create new variable pscaleforg and
c     pass in common block consts.  Perform gravity correction when
c     computing rayleigh optical depth and storing in array ps.
c     Also use logical switch lgcorrect
c     to impliment the gravity correction to the rayleigh scattering
c     optical depth.
c
cccc
      implicit integer*4(i-n),real*8 (a-h,o-z)
      real *8 h(487),ps(487),hhold(100),pshold(101),
     1 cofx(4,487)
c
      include "prints.inc"
      include "consts.inc"
      include "thkns.inc"
      include "atmos.inc"
      include "chpmn.inc"
      include "cgcorrect.inc"
c
c*****use the ps and h that were saved before
c
   80 do 82 i=1,lmax
      h(i)=hhold(i)
   82 ps(i)=pshold(i)
c
c*****renumber the layers to put layer 1 near the top of the atmos.
c***** (standard atmos. is read in a reverse order)
c
   85 continue
      lmaxd2 = lmax/2
      do 100 i = 1, lmax
      if(lgcorrect)then                                       !def
        ps(i) = beta*ps(i)*(1.0d0-pscaleforg*dlog(ps(i)))**2  !def
      else						      !def
        ps(i) = beta*ps(i)
      endif						      !def
  100 continue
      do 110 i = 1, lmaxd2
      k = lmax - i + 1
      hold = h(i)
      h(i) = h(k)
      h(k) = hold
      hold = ps(i)
      ps(i) = ps(k)
  110 ps(k) = hold
c
c*****subdivide the layers of std. atmos. by interpolation
c*****assume pressure dependence between the layers of the form
c*****          p=pnot**(-h/hnot)
c
      lmax = layer*(lmax - 1) + 1
      lmaxm1 = lmax - 1
      layrm1 = layer - 1
      do 112 i = 1, lmax, layer
      j = lmax - i + 1
      k = j/layer + 1
      h(j) = h(k)
  112 ps(j) = ps(k)
      frac = 1./float(layer)
      fracin = r*float(layer)
      lmaxml = lmax - layer
      do 114 i = 1, lmaxml, layer
      k = i + layer
      dum = (ps(k)/ps(i))**frac
      k = i
      do 114 j = 1, layrm1
      k = k + 1
      h(k) = h(k-1) - frac
  114 ps(k) = ps(i)*dum**j
c
c*****use spline interpol. to obtain total opt. depth of each layer
c*****         in the standard atmosphere  (xs)
c
      j = 1
      dum = dlog(ps(j))
      do 130 i = 2, 101
      if (dum .gt. tsl(i)) go to 130
      k = i - 1
  120 dum1 = tsl(i) - dum
      dum2 = dum -  tsl(k)
      dum3 = dum1*(cofx(1,k)*dum1**2 + cofx(3,k)) + dum2*(cofx(2,k)*
     1dum2**2 + cofx(4,k))
      xs(j) = dexp(dum3)
      j = j + 1
      if (j .gt. lmax) go to 140
      dum = dlog(ps(j))
      if (dum .le. tsl(i))   go to 120
  130 continue
c
c*****calculate ps(rayleigh opt. thickness) and dxs(total opt. thick)
  140 dxs(1) = xs(1)
      holdc = ps(1)
      do 150 i = 2, lmax
      holdd = ps(i)
      ps(i) = holdd - holdc
      holdc = holdd
  150 dxs(i) = xs(i) - xs(i-1)
      do 160 i = 1, lmax
      xs(i) = dlog(xs(i))
  160 h(i) = 1. + h(i)*rinv
      if(jprint(7).ne.0)
     1 write(33,6400)(h(i),ps(i),xs(i),dxs(i),i=1,lmax)
      dum = r*h(1)
      mm=20*layer+2
      scalp=20./dlog(ps(mm)/ps(2))
      scalx = scalp
      scalx=20./dlog((dxs(mm)-ps(mm))/(dxs(2)-ps(2)))
      chp = dum/scalp*0.5
      chx = dum/scalx*0.5
      chpn = dsqrt(chp*pi)
      chxn = dsqrt(chx*pi)
      sqchp = dsqrt(chp)
      sqchx = dsqrt(chx)
 6400 format (1h1,2(5x,1hh,14x,2hps,14x,2hxs,13x,3hdxs,9x)/1h,/,
     1 (1h ,2(f10.8, 3d16.4, 5x)))
      return
      end