c  $Header: /usr/people/flittner/radtran/tomrad/pv2.2/src/RCS/emmat.f,v 2.22 2000/08/30 16:38:09 flittner Exp $
      subroutine emmat (imu,imuz,iazmth,thnot,thta,azmth)
c
c***********************************************************************
c
cccc
c     subroutine emmat
c     version aug. 1, 1977
c     purpose
c
c        set up matrix m for each polar backscatter angle
c        and adjoint of m for each solar zenith angle. stores sines
c        and cosines of azimuth and 2*azimuth angles
c
c     method
c
c     see dave's paper may 13, 1964
c
c     calling sequence
c
c        call emmat (imu,imuz,iazmth,thnot,thta,azmth,ematx,
c                    admatx,saz,caz,saz2,caz2,emu,emuz)
c
c        variable   type    i/o  description
c        --------   ----    ---  -----------
c
c        imu         i*4     i   # polar backscatter angles
c        imuz        i*4     i   # solar zenith angles
c        iazmth      i*4     i   # azimuth angles
c        thnot(n)    r*8     i   solar zenith angles (degs)
c        thta(n)     r*8     i   polar back scatter angles (degs)
c        azmth(n)    r*8     i   azimuth angles (degs)
c
c        ematx(3,n)  r*8     o   m matrix
c        admatx(3,n) r*8     o   adjoint matrix
c        saz(m)      r*8     o   sine of azimuth angle
c        caz(m)      r*8     o   cosine of azimuth angle
c        saz2(m)     r*8     o   2*sine of azimuth angle
c        caz2(m)     r*8     o   2*cosine of azimuth angle
c        emu(n)      r*8     o   cosine of polar backscatter angle
c        emuz(n)     r*8     o   cosine of solar zenith angles
c
c     external references
c        none
c
c     author
c        p. m. smith,sasc,aug 1, 1977
c     modifications
c        (date name purpose)
c     last modified by zia ahmad  9/10/93
c     purpose: to include the effect of molecular anisotropy
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.
cccc
c***********************************************************************
c
      implicit none
      include 'parameter.inc'
c passed
      integer imu,imuz,iazmth
      real*8 thnot(max_sza),thta(max_scan),azmth(max_az)
      include 'emm.cmn'
      include 'consts.cmn'
      include 'depolt.cmn'
c local
      integer l,i
      real*8 thet,phi,phi2
c
c
c             set up adjoint
c
c    new statements added in do loops 100 and 200
c
      do 100 l=1,imuz
         thet=cnvrt*thnot(l)
         emuz(l)=dcos(thet)
         if(ipol.eq.0)then
             admatx(1,l)=emuz(l)*emuz(l)
             admatx(2,l)=1.0d0
             admatx(3,l)=sq2*(1.0d0-admatx(1,l))
         else
             admatx(1,l)=q+emuz(l)**2
             admatx(2,l)=1.0d0+q
             admatx(3,l)=delp*(1.0d0-emuz(l)**2)
         endif
  100 continue
c
c             set up m matrix
c
      do 200 l=1,imu
         thet=cnvrt*thta(l)
         emu(l)=dcos(thet)
c      write(33,555)l,thta(l),emu(l)
 555  format('emmat',i4,1p2e12.4)
         if(ipol.eq.0)then
             ematx(1,l)=emu(l)*emu(l)
             ematx(2,l)=sq2*(1.0d0-ematx(1,l))
             ematx(3,l)=1.0d0
         else
             ematx(1,l)=q+emu(l)**2
             ematx(2,l)=delp*(1.0d0-emu(l)**2)
             ematx(3,l)=1+q
         endif
  200 continue
c
c             store trig functions
c
      do 300 i=1,iazmth
         phi=azmth(i)*cnvrt
         phi2=2.0d0*phi
         saz(i)=dsin(-phi)
         saz2(i)=dsin(-phi2)
         caz(i)=dcos(phi)
         caz2(i)=dcos(phi2)
  300 continue
      return
      end