      SUBROUTINE GETMUELLER(IBETA,IORTH,IPHI,ITHETA,MXBETA,
     &                      MXSCA,MXPHI,MXTHET,NSCAT,
     &                      CMDTRQ,PHIN,SM,SMORI,
     &                      S1111,S2121,
     &                      CX1121,CXE01,CXE02,
     &                      CXF11,CXF12,CXF21,CXF22,
     &                      CXS1,CXS2,CXS3,CXS4,
     &                      QABS,QABSUM,QBKSCA,QBKSUM,QEXSUM,
     &                      QEXT,QPHA,QPHSUM,QSCAG,QSCAG2,QSCAT,
     &                      QSCG2SUM,QSCGSUM,QSCSUM,QTRQAB,
     &                      QTRQABSUM,QTRQSC,QTRQSCSUM,WGTA,WGTB)
      IMPLICIT NONE

C Arguments:

      INTEGER 
     &   IBETA,IORTH,IPHI,ITHETA,
     &   MXBETA,MXSCA,MXPHI,MXTHET,
     &   NSCAT
      CHARACTER 
     &   CMDTRQ*6
      REAL WG
      REAL 
     &   PHIN(MXSCA),QABS(2),QABSUM(2),QBKSCA(2),QBKSUM(2),QEXSUM(2),
     &   QEXT(2),QPHA(2),QPHSUM(2),QSCAG(3,2),QSCAG2(2),QSCAT(2),
     &   QSCG2SUM(2),QSCGSUM(3,2),QSCSUM(2),QTRQAB(3,2),QTRQABSUM(3,2),
     &   QTRQSC(3,2),QTRQSCSUM(3,2),S1111(MXSCA),S2121(MXSCA),
     &   SM(MXSCA,4,4),SMORI(MXSCA,4,4),
     &   WGTA(MXTHET,MXPHI),WGTB(MXBETA)
      COMPLEX 
     &   CX1121(MXSCA),CXE01(3),CXE02(3),
     &   CXF11(MXSCA),CXF12(MXSCA),CXF21(MXSCA),CXF22(MXSCA),
     &   CXS1(MXSCA),CXS2(MXSCA),CXS3(MXSCA),CXS4(MXSCA)

C Local variables:

      INTEGER J,K,JO,ND
      REAL COSPHI,SINPHI
      COMPLEX CXA,CXB,CXC,CXD,CXI
      DATA CXI/(0.,1.)/
      SAVE CXI
C***********************************************************************
C Given:
C   IBETA =index specifying rotation of target around axis a1
C   IORTH =number of incident polarization states being calculated for
C   IPHI  =index specifying phi value for orientation of target axis a1
C   ITHETA=index specifying theta value for orientation of target axis
C          a1
C   MXBETA=dimensioning information
C   MXSCA =dimensioning information
C   MXPHI =dimensioning information
C   MXTHET=dimensioning information
C   NSCAT =number of scattering directions for evaluation of Mueller
C          matrix
C   CMDTRQ='DOTORQ' or 'NOTORQ' depending on whether or not torque
C          calculation is to be carried out
C   PHIN(1-NSCAT)=values of PHI for scattering directions 1-NSCAT
C   S1111(1-NSCAT)=weighted sum of |f_11|^2 over previous orientations
C   S2121(1-NSCAT)=weighted sum of |f_21|^2 over previous orientations
C   CXE01(1-3)    =incident pol state 1 in Lab Frame
C   CXE02(1-3)    =                   2
C   CXF11(1-NSCAT)=f_11 for current orientation
C   CXF12(1-NSCAT)=f_12 for current orientation
C   CXF21(1-NSCAT)=f_21 for current orientation
C   CXF22(1-NSCAT)=f_22 for current orientation
C   QABS(2)       =Q_abs for two incident polarizations
C   QABSUM(2)     =weighted sum of Qabs over previous orientations
C   QBKSCA(2)     =Q_bk for two incident polarizations
C   QBKSUM(2)     =weighted sum of Q_bk over previous orientations
C   QEXSUM(2)     =weighted sum of Q_ext over previous orientations
C   QEXT(2)       =Q_ext for two incident polarizations
C   QPHA(2)       =Q_pha for two incident polarizations
C   QPHSUM(2)     =weighted sum of Q_ph over previous orientations
C   QSCAG(3,2)    =Q_pr vector for two incident polarizations
C   QSCAT(2)      =Q_sca for two incident polarizations
C   QSCGSUM(3,2)  =weighted sum of Q_pr vector over prev. orients.
C   QSCSUM(2)     =weighted sum of Q_sca over previous orientations
C   QTRQAB(3,2)   =absorptive part of Q_gamma for two inc. pols.
C   QTRQABSUM(3,2)=weighted sum of Q_gamma over previous orientations
C   QTRQSC(3,2)   =scattering part of Q_gamma for two inc. pols.
C   QTRQSCSUM(3,2)=weighted sum of Q_gamma over previous orientations
C   WGTA(ITHETA,IPHI)=weight factor for theta,phi orientation
C   WGTB(IBETA)      =weight factor for beta orientation
C   SMORI(1-NSCAT,4,4)=weighted sum of Mueller matrix over previous
C                      orientations
C If IORTH=1, returns:
C   S1111(1-NSCAT)=updated weighted sum of |f_11|^2 over NSCAT 
C                  scattering directions
C   S2121(1-NSCAT)=updated weighted sum of |f_21|^2
C   CX1121(1-NSCAT)=updated weighted summ of f_11*conjg(f_21)
C
C If IORTH=2, returns:
C   SM(1-NSCAT,4,4)=Mueller matrix for current orientation, and NSCAT
C                   scattering directions
C   CXS1(1-NSCAT)=amplitude scattering matrix element S_1 for current
C                 orientation
C   CXS2(1-NSCAT)=amplitude scattering matrix element S_2 for current
C                 orientation
C   CXS3(1-NSCAT)=amplitude scattering matrix element S_3 for current
C                 orientation
C   CXS4(1-NSCAT)=amplitude scattering matrix element S_4 for current
C                 orientations
C   QABSUM(2)     =updated weighted sum of Q_abs
C   QBKSUM(2)     =updated weighted sum of Q_bk
C   QEXSUM(2)     =updated weighted sum of Q_ext
C   QSCGSUM(3,2)  =updated weighted sum of Q_pr vector
C   QSCSUM(2)     =updated weighted sum of Q_sca
C   QTRQABSUM(3,2)=updated weighted sum of absorptive contribution to
C                  Q_gamma
C   QTRQSCSUM(3,2)=updated weighted sum of scattering contribution to
C                  Q_gamma
C
C   SMORI(1-NSCAT,4,4)=updated weighted sum of Mueller matrix elements
C                 
C History:
C 96.11.11 (BTD) ready for use
C 97.07.24 (BTD) corrected error in computation of amplitude scattering
C                matrix elements (CXS1,CXS2,CXS3,CXS4) and Mueller matrix
C                elements SM.  Until now code mistakenly used PHI
C                defining target orientation rather than PHIN 
C                defining scattering direction.  Correction of error
C                required replacing PHI by PHIN in argument list,
C                thereby requiring corresponding change in DDSCAT.
C                All calculated Mueller matrix elements until now were
C                therefore incorrect except for special cases where
C                PHI and PHIN were coincidentally the same (e.g.
C                target orientation PHI=0 and scattering plane PHIN=0).
C                This error was pointed out by Henriette Lemke (Inst.
C                for Atmospheric Physics, GKSS - Research Center,
C                Geesthacht.
C 97.07.24 (BTD) also corrected sign mistake in evaluation of S_14
C                and typo in evaluation of S_31.  Note that since S_31
C                had been evaluated incorrectly, PPOL (evaluated by
C                subroutine WRITESCA) was then numerically incorrect.
C 98.11.01 (BTD) Timo Nousiainen (tpnousia@lumi.meteo.helsinki.fi)
C                reported a problem with S_12 computed by DDSCAT for
C                a pseudosphere target when the scattering plane has
C                e.g. phi=90.  Problem is real and must be tracked down
C                and corrected.
C 98.11.16 (BTD) Modified code calculating complex amplitude scattering
C                matrix elements S1,S2,S3,S4 from f_ij.
C 00.06.13 (BTD) make data conversions explicit
C 03.10.23 (BTD) add QSCAG2 and QSCAG2SUM to argument list
C                add code to update QSCAG2SUM
C end history
C
C Copyright (C) 1996,1997,1998,2000,2003
C               B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C*********  Sum scattering properties over orientations ****************
C
C Correspondence to notation of Bohren & Huffman (1983):
C Our f_jk correspond to notation of Draine (1988).  
C For the special case where incident polarization modes 1 and 2 are
C parallel and perpendicular to the scattering plane, we have the
C relationship between the f_jk and the elements S_j of the amplitude 
C scattering matrix as defined by Bohren & Huffman (1983) is as follows:
C     S_1 = -i*f_22
C     S_2 = -i*f_11
C     S_3 =  i*f_12
C     S_4 =  i*f_21
C In this case (incident pol. states parallel,perpendicular to the
C scattering plane), the elements of the 4x4 Mueller matrix (see Bohren & 
C Huffman 1983) are related to our f_jk as follows:
C     S_11 = [|f_11|^2 + |f_22|^2 + |f_12|^2 + |f_21|^2]/2
C     S_12 = [|f_11|^2 + |f_21|^2 - |f_22|^2 - |f_12|^2]/2
C     S_13 = -Re[f_11*conjg(f_12) + f_22*conjg(f_21)]
C     S_14 =  Im[f_22*conjg(f_21) - f_11*conjg(f_12)]
C     S_21 = [|f_11|^2 + |f_12|^2 - |f_22|^2 - |f_21|^2]/2
C     S_22 = [|f_11|^2 + |f_22|^2 - |f_21|^2 - |f_12|^2]/2
C     S_23 =  Re[f_22*conjg(f_21) - f_11*conjg(f_12)]
C     S_24 = -Im[f_11*conjg(f_12) + f_22*conjg(f_21)]
C     S_31 = -Re[f_11*conjg(f_21) + f_22*conjg(f_22)]
C     S_32 =  Re[f_22*conjg(f_12) - f_22*conjg(f_21)]
C     S_33 =  Re[f_22*conjg(f_11) + f_12*conjg(f_21)]
C     S_34 =  Im[f_11*conjg(f_22) + f_21*conjg(f_22)]
C     S_41 = -Im[f_21*conjg(f_11) + f_22*conjg(f_12)]
C     S_42 =  Im[f_22*conjg(f_12) - f_22*conjg(f_11)]
C     S_43 =  Im[f_22*conjg(f_11) - f_12*conjg(f_21)]
C     S_44 =  Re[f_22*conjg(f_11) - f_12*conjg(f_21)]
C
C Notation internal to this program: 
C ij.ne.kl: CX_ijkl = \f_ij* \times f_kl  (summed over orientations)
C            S_ijij = \f_ij* \times f_ij  (summed over orientations)
C 4 pure real elements: S1111,S1212,S2121,S2222
C 8 complex elements:   CX1112,CX1121,CX1122,CX1221,CX1222,CX2122
C 4 redundant elts.:    CX1211 = Conjg(CX1112)
C                       CX2111 = Conjg(CX1121)
C                       CX2112 = Conjg(CX1221)
C                       CX2211 = Conjg(CX1122)
C
C In this routine we will carry out fully general calculation of the
C 4x4 Mueller matrix elements, valid for arbitrary incident polarization
C states j=1,2 for which we have the scattering matrix f_ij
C
C First, we compute the amplitude scattering matrix elements S_1,S_2,
C S_3,S_4 as defined by Bohren & Huffman:
C=======================================================================

C WG=weighting factor for this orientation

      WG=WGTA(ITHETA,IPHI)*WGTB(IBETA)
      IF(IORTH.EQ.2)THEN

C CXE01,CXE02 are unit incident polarization vectors in Lab Frame.
C We assume CXE01 and CXE02 are normalized (REAPAR makes sure of this).
C CXA,CXB,CXC,CXD are complex coefficients corresponding to dot product
C of complex polarization vectors CXE01,CXE02 with y and z unit vectors
C in Lab Frame.

         CXA=CONJG(CXE01(2))
         CXB=CONJG(CXE01(3))
         CXC=CONJG(CXE02(2))
         CXD=CONJG(CXE02(3))

C Compute complex scattering amplitudes S_1,S_2,S_3,S_4 for this
C particular target orientation and NSCAT scattering directions:

         DO ND=1,NSCAT
            SINPHI=SIN(PHIN(ND))
            COSPHI=COS(PHIN(ND))
            CXS1(ND)= CXI*(CXF21(ND)*(CXA*SINPHI-CXB*COSPHI)+
     &                     CXF22(ND)*(CXC*SINPHI-CXD*COSPHI))
            CXS2(ND)=-CXI*(CXF11(ND)*(CXB*SINPHI+CXA*COSPHI)+
     &                     CXF12(ND)*(CXD*SINPHI+CXC*COSPHI))
            CXS3(ND)=-CXI*(CXF11(ND)*(CXA*SINPHI-CXB*COSPHI)+
     &                     CXF12(ND)*(CXC*SINPHI-CXD*COSPHI))
            CXS4(ND)= CXI*(CXF21(ND)*(CXB*SINPHI+CXA*COSPHI)+
     &                     CXF22(ND)*(CXD*SINPHI+CXC*COSPHI))
         ENDDO

C Now compute Mueller matrix elements for this particular target
C orientation:

         DO ND=1,NSCAT
            SM(ND,1,1)=0.5*REAL(CXS1(ND)*CONJG(CXS1(ND))+
     &                          CXS2(ND)*CONJG(CXS2(ND))+
     &                          CXS3(ND)*CONJG(CXS3(ND))+
     &                          CXS4(ND)*CONJG(CXS4(ND)))
            SM(ND,1,2)=0.5*REAL(CXS2(ND)*CONJG(CXS2(ND))-
     &                          CXS1(ND)*CONJG(CXS1(ND))+
     &                          CXS4(ND)*CONJG(CXS4(ND))-
     &                          CXS3(ND)*CONJG(CXS3(ND)))
            SM(ND,1,3)=REAL(CXS2(ND)*CONJG(CXS3(ND))+
     &                      CXS1(ND)*CONJG(CXS4(ND)))
            SM(ND,1,4)=AIMAG(CXS2(ND)*CONJG(CXS3(ND))-
     &                       CXS1(ND)*CONJG(CXS4(ND)))
            SM(ND,2,1)=0.5*REAL(CXS2(ND)*CONJG(CXS2(ND))-
     &                          CXS1(ND)*CONJG(CXS1(ND))-
     &                          CXS4(ND)*CONJG(CXS4(ND))+
     &                          CXS3(ND)*CONJG(CXS3(ND)))
            SM(ND,2,2)=0.5*REAL(CXS2(ND)*CONJG(CXS2(ND))+
     &                          CXS1(ND)*CONJG(CXS1(ND))-
     &                          CXS4(ND)*CONJG(CXS4(ND))-
     &                          CXS3(ND)*CONJG(CXS3(ND)))
            SM(ND,2,3)=REAL(CXS2(ND)*CONJG(CXS3(ND))-
     &                      CXS1(ND)*CONJG(CXS4(ND)))
            SM(ND,2,4)=AIMAG(CXS2(ND)*CONJG(CXS3(ND))+
     &                       CXS1(ND)*CONJG(CXS4(ND)))
            SM(ND,3,1)=REAL(CXS2(ND)*CONJG(CXS4(ND))+
     &                      CXS1(ND)*CONJG(CXS3(ND)))
            SM(ND,3,2)=REAL(CXS2(ND)*CONJG(CXS4(ND))-
     &                      CXS1(ND)*CONJG(CXS3(ND)))
            SM(ND,3,3)=REAL(CXS1(ND)*CONJG(CXS2(ND))+
     &                      CXS3(ND)*CONJG(CXS4(ND)))
            SM(ND,3,4)=AIMAG(CXS2(ND)*CONJG(CXS1(ND))+
     &                       CXS4(ND)*CONJG(CXS3(ND)))
            SM(ND,4,1)=AIMAG(CXS4(ND)*CONJG(CXS2(ND))+
     &                       CXS1(ND)*CONJG(CXS3(ND)))
            SM(ND,4,2)=AIMAG(CXS4(ND)*CONJG(CXS2(ND))-
     &                       CXS1(ND)*CONJG(CXS3(ND)))
            SM(ND,4,3)=AIMAG(CXS1(ND)*CONJG(CXS2(ND))-
     &                       CXS3(ND)*CONJG(CXS4(ND)))
            SM(ND,4,4)=REAL(CXS1(ND)*CONJG(CXS2(ND))-
     &                      CXS3(ND)*CONJG(CXS4(ND)))
         ENDDO

C Augment Mueller matrix for orientational average

         DO J=1,4
            DO K=1,4
               DO ND=1,NSCAT
                  SMORI(ND,J,K)=SMORI(ND,J,K)+WG*SM(ND,J,K)
               ENDDO
            ENDDO
         ENDDO

C***********************************************************************

      ELSE

C When IORTH=1, cannot compute full Mueller matrix.
C Compute three scattering properties:

         DO ND=1,NSCAT
            S1111(ND)=S1111(ND)+WG*REAL(CONJG(CXF11(ND))*CXF11(ND))
            S2121(ND)=S2121(ND)+WG*REAL(CONJG(CXF21(ND))*CXF21(ND))
            CX1121(ND)=CX1121(ND)+WG*REAL(CONJG(CXF11(ND))*CXF21(ND))
         ENDDO
      ENDIF

C**** Now augment sums of QABS,QBKSCA,QEXT,QSCA,G*QSCA over incident
C     directions and polarizations.

      DO JO=1,IORTH
         QEXSUM(JO)=QEXSUM(JO)+QEXT(JO)*WG
         QABSUM(JO)=QABSUM(JO)+QABS(JO)*WG
         QBKSUM(JO)=QBKSUM(JO)+QBKSCA(JO)*WG
         QPHSUM(JO)=QPHSUM(JO)+QPHA(JO)*WG
         QSCSUM(JO)=QSCSUM(JO)+QSCAT(JO)*WG
         QSCG2SUM(JO)=QSCG2SUM(JO)+QSCAG2(JO)*WG
         DO J=1,3
            QSCGSUM(J,JO)=QSCGSUM(J,JO)+QSCAG(J,JO)*WG
         ENDDO
         IF(CMDTRQ.EQ.'DOTORQ')THEN
            DO J=1,3
               QTRQABSUM(J,JO)=QTRQABSUM(J,JO)+QTRQAB(J,JO)*WG
               QTRQSCSUM(J,JO)=QTRQSCSUM(J,JO)+QTRQSC(J,JO)*WG
            ENDDO
         ENDIF
      ENDDO
      RETURN
      END

