      SUBROUTINE WRITESCA(MXNX,MXNY,MXNZ,NX,NY,NZ,ICOMP,IXYZ0,MXNAT,
     &                    MXN3,NAT,NAT3,WAVEA,MXWAV,NWAV,AEFFA,MXRAD,
     &                    NRAD,ITHETA,IBETA,IPHI,THETA,MXTHET,NTHETA,
     &                    BETA,MXBETA,NBETA,PHI,MXPHI,NPHI,TIMERS,
     &                    MXTIMERS,NTIMERS,CBINFILE,IOBIN,CBINFLAG,
     &                    CNETFILE,IDNC,CNETFLAG,ICTHM,ILIN10,ILIN12,
     &                    IORI,IORTH,IPHIM,IRAD,IWAV,MXCOMP,MXSCA,NAT0,
     &                    NCOMP,NORI,NSCAT,CALPHA,CDESCR,CFLAVG,CFLSCA,
     &                    CMDFFT,CMDTRQ,CSHAPE,CSTAMP,AEFF,AK1,AKR,
     &                    BETAD,BETMID,BETMXD,PHID,PHIMID,PHIMXD,THETAD,
     &                    THTMID,THTMXD,TOL,WAVE,XX,A1,A2,PHIN,QABS,
     &                    QABSUM,QBKSCA,QBKSUM,QEXSUM,QEXT,QPHA,QPHSUM,
     &                    QSCAG,QSCAT,QSCGSUM,QSCSUM,QTRQAB,QTRQABSUM,
     &                    QTRQSC,QTRQSCSUM,S1111,S2121,SM,SMORI,THETAN,
     &                    CX1121,CXE01,CXE01R,CXE02,CXE02R,CXEPS,CXRFR,
     &                    CXF11,CXF21,CXF12,CXF22)

C     .. Scalar Arguments ..
      REAL AEFF,AK1,BETAD,BETMID,BETMXD,PHID,PHIMID,PHIMXD,THETAD,
     &     THTMID,THTMXD,TOL,WAVE,XX
      INTEGER IBETA,ICTHM,IDNC,ILIN10,ILIN12,IOBIN,IORI,IORTH,IPHI,
     &        IPHIM,IRAD,ITHETA,IWAV,MXBETA,MXCOMP,MXN3,MXNAT,MXNX,MXNY,
     &        MXNZ,MXPHI,MXRAD,MXSCA,MXTHET,MXTIMERS,MXWAV,NAT,NAT0,
     &        NAT3,NBETA,NCOMP,NORI,NPHI,NRAD,NSCAT,NTHETA,NTIMERS,NWAV,
     &        NX,NY,NZ
      CHARACTER CALPHA*6,CBINFLAG*6,CMDFFT*6,CMDTRQ*6,CNETFLAG*6,
     &          CSHAPE*6,CFLAVG*13,CBINFILE*14,CFLSCA*14,CNETFILE*14,
     &          CSTAMP*22,CDESCR*67
C     .. Array Arguments ..
      COMPLEX CX1121(MXSCA),CXE01(3),CXE01R(3),CXE02(3),CXE02R(3),
     &        CXEPS(MXCOMP),CXF11(MXSCA),CXF12(MXSCA),CXF21(MXSCA),
     &        CXF22(MXSCA),CXRFR(MXCOMP)
      REAL A1(3),A2(3),AEFFA(MXRAD),AKR(3),BETA(MXBETA),PHI(MXPHI),
     &     PHIN(MXSCA),QABS(2),QABSUM(2),QBKSCA(2),QBKSUM(2),QEXSUM(2),
     &     QEXT(2),QPHA(2),QPHSUM(2),QSCAG(3,2),QSCAT(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),THETA(MXTHET),THETAN(MXSCA),
     &     TIMERS(MXTIMERS),WAVEA(MXWAV)
      INTEGER*2 ICOMP(MXN3),IXYZ0(MXNAT,3)
C     .. Local Scalars ..
      COMPLEX CXVAR1
      REAL DEGRAD,PHIND,PPOL,RVAR1,RVAR2,RVAR3,THETND
      INTEGER I,J,ND
C     .. Local Arrays ..
      REAL G(2),QAV(17)
C     .. External Subroutines ..
      EXTERNAL NAMER,WRITEBIN,WRITENET
C     .. Intrinsic Functions ..
      INTRINSIC CONJG,SQRT
C     .. Save statement ..
      SAVE DEGRAD
C     .. Data statements ..
      DATA DEGRAD/57.29578/
C***********************************************************************
C
C Purpose of this module is to collect a lot of the output code into
C a single module.
C
C History:
C 96.11.14 (PJF) added binary write options (see also info in
C                "versions.f" about IDL postprocessing)
C                possible "chackpointing" could be done here "close(iobin)"
C                open(iobin,file=cbinfile,form='unformatted',access='append')
C                (which is non-standard Fortran 77 (but standard in F90)
C                open(iobin,file=cbinfile,form='unformatted',status='old')
C 96.11.21 (BTD) added call to WRITENET if called with CNETFLAG='NCCLOS'
C                in order to get call to NCCLOS out of DDSCAT.f
C 98.11.16 (BTD) corrected CX01R -> CXE01R in argument list of WRITEBIN
C end history
C
C Copyright (C) 1996,1998 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C
C If CNETFLAG = 'NCCLOS' then call WRITESCA to
C                             call WRITENET to
C                             call NCCLOS to close netCDF files
      IF(CNETFLAG.EQ.'NCCLOS')THEN
         CALL WRITENET(CNETFILE,IDNC,CNETFLAG,CSTAMP,CDESCR,CMDFFT,
     &                 CALPHA,CSHAPE,CMDTRQ,MXWAV,MXRAD,MXTHET,MXBETA,
     &                 MXPHI,MXN3,MXNAT,MXSCA,MXTIMERS,IORTH,NX,NY,NZ,
     &                 NAT0,NAT,NAT3,NSCAT,NCOMP,NORI,NWAV,NRAD,NTHETA,
     &                 NPHI,NBETA,NTIMERS,MXNX,MXNY,MXNZ,MXCOMP,
     &                 BETMID,BETMXD,THTMID,THTMXD,PHIMID,PHIMXD,ICTHM,
     &                 IPHIM,TOL,WAVEA,AEFFA,THETA,BETA,PHI,A1,A2,
     &                 ICOMP,IXYZ0,IWAV,IRAD,ITHETA,IBETA,IPHI,IORI,
     &                 AEFF,WAVE,XX,AK1,BETAD,THETAD,PHID,AKR,CXE01R,
     &                 CXE02R,CXRFR,CXEPS,QEXT,QABS,QSCAT,G,QBKSCA,
     &                 QPHA,QAV,QTRQAB,QTRQSC,SM,SMORI,PHIN,THETAN,
     &                 TIMERS)
         RETURN
      ENDIF
C If IORI > 0, then write out scattering properties for this specific
C target orientation.
      IF(IORI.GT.0)THEN
C*** Compute g=<cos(theta)>
          DO 12 J=1,IORTH
              G(J)=QSCAG(1,J)/QSCAT(J)
   12     CONTINUE
          CALL NAMER(IWAV,IRAD,IORI,CFLSCA,CFLAVG)
          OPEN(UNIT=8,FILE=CFLSCA,STATUS='UNKNOWN')
          WRITE(8,FMT=9030)CSTAMP,CDESCR,CMDFFT,CALPHA,CSHAPE,NAT0
          WRITE(8,FMT=9032)AEFF,WAVE,XX
          WRITE(8,FMT=9031)(CXRFR(ND),CXEPS(ND),ND,ND=1,NCOMP)
          WRITE(8,FMT=9033)TOL,ICTHM,IPHIM,A1,A2
          WRITE(8,FMT=9035)AKR,CXE01R,CXE02R
          WRITE(8,FMT=9040)BETAD,THETAD,PHID
          WRITE(8,FMT=9050)QEXT(1),QABS(1),QSCAT(1),G(1),QBKSCA(1),
     &      QPHA(1)
          IF(IORTH.EQ.1)THEN
Cflatau  assign "missing value" value if there is only one polarization
              DO 13 I=1,17
                  QAV(I)=-999.
   13         CONTINUE
              QEXT(2)=-999.
              QABS(2)=-999.
              QSCAT(2)=-999.
              QBKSCA(2)=-999.
              QPHA(2)=-999.
              G(2)=-999.
              DO 14 J=1,3
                  QSCAG(J,2)=-999.
   14         CONTINUE
C endif "IF(IORTH.EQ.1)THEN"
          END IF


          IF(IORTH.EQ.2)THEN
              QAV(1)=.5*(QEXT(1)+QEXT(2))
              QAV(2)=.5*(QABS(1)+QABS(2))
              QAV(3)=.5*(QSCAT(1)+QSCAT(2))
              QAV(4)=.5*(QSCAG(1,1)+QSCAG(1,2))/QAV(3)
              QAV(5)=.5*(QBKSCA(1)+QBKSCA(2))
              QAV(6)=.5*(QPHA(1)+QPHA(2))
              QAV(7)=QEXT(1)- QEXT(2)
              QAV(8)=QPHA(1)- QPHA(2)
              DO 16 J=1,3
                  QAV(8+J)=.5*(QSCAG(J,1)+QSCAG(J,2))
   16         CONTINUE
              IF(CMDTRQ.EQ.'DOTORQ')THEN
                  DO 17 J=1,3
                      QAV(11+J)=.5*(QTRQAB(J,1)+QTRQAB(J,2))
                      QAV(14+J)=.5*(QTRQSC(J,1)+QTRQSC(J,2))
   17             CONTINUE
              ENDIF

              WRITE(8,FMT=9055)QEXT(2),QABS(2),QSCAT(2),G(2),
     &          QBKSCA(2),QPHA(2),(QAV(J),J=1,8)
          ENDIF

          WRITE(8,FMT=9150)(QSCAG(J,1),J=1,3)
          IF(IORTH.EQ.2)THEN
              WRITE(8,FMT=9155)(QSCAG(J,2),J=1,3),(QAV(J),J=9,11)
          ENDIF

          IF(CMDTRQ.EQ.'DOTORQ')THEN
              WRITE(8,FMT=9250)(QTRQAB(J,1),J=1,3),
     &          (QTRQSC(J,1),J=1,3)
              IF(IORTH.EQ.2)WRITE(8,FMT=9255)(QTRQAB(J,2),J=1,3),
     &            (QTRQSC(J,2),J=1,3),(QAV(J),J=12,17)

          ELSE
CFLATAU --->DRAINE is j=1 set for IORTH=1 ???? in QTRQAB, QTRQSC ??
C add missing value code (set to -999.)
              DO 19 I=1,3
                  DO 21 J=1,2
                      QTRQAB(I,J)=-999.
                      QTRQSC(I,J)=-999.
   21             CONTINUE
   19         CONTINUE
C endif "IF(CMDTRQ.EQ.'DOTORQ')THEN"
          ENDIF

          IF(IORTH.EQ.1)THEN
              WRITE(8,FMT=9060)
              DO 22 ND=1,NSCAT
C convert scattering angles to degrees
                  PHIND=DEGRAD*PHIN(ND)
                  THETND=DEGRAD*THETAN(ND)
                  RVAR1=CONJG(CXF11(ND))*CXF11(ND)
                  RVAR2=CONJG(CXF21(ND))*CXF21(ND)
                  CXVAR1=CONJG(CXF11(ND))*CXF21(ND)
                  WRITE(8,FMT=9070)ND,THETND,PHIND,RVAR1,RVAR2,CXVAR1
   22         CONTINUE

          ELSE IF(IORTH.EQ.2)THEN
              WRITE(8,FMT=9080)
              DO 27 ND=1,NSCAT
C convert scattering angles to degrees
                  PHIND=DEGRAD*PHIN(ND)
                  THETND=DEGRAD*THETAN(ND)
C
C Compute PPOL = degree of linear polarization of scattered light
C for incident unpolarized light
C
                  PPOL=SQRT(SM(ND,2,1)**2+SM(ND,3,1)**2)/
     &                   SM(ND,1,1)
                  WRITE(8,FMT=9090)THETND,PHIND,SM(ND,1,1),SM(ND,2,1),
     &              SM(ND,3,1),SM(ND,4,1),SM(ND,1,2),SM(ND,1,3),PPOL
   27         CONTINUE
C endif "IF(IORTH.EQ.1)THEN"
          ENDIF

          CLOSE(8)
C
      ELSE
C This module writes out results from orientational averaging.
C (arrive here when called with IORI=0)
C
          OPEN(UNIT=8,FILE=CFLAVG,STATUS='UNKNOWN')
          WRITE(8,FMT=9030)CSTAMP,CDESCR,CMDFFT,CALPHA,CSHAPE,NAT0
          WRITE(8,FMT=9032)AEFF,WAVE,XX
          WRITE(8,FMT=9031)(CXRFR(ND),CXEPS(ND),ND,ND=1,NCOMP)
          WRITE(8,FMT=9033)TOL,ICTHM,IPHIM,A1,A2
          RVAR1=AK1
          RVAR2=0.
          RVAR3=0.
          WRITE(8,FMT=9037)RVAR1,RVAR2,RVAR3,CXE01,CXE02
          WRITE(8,FMT=9042)BETMID,BETMXD,NBETA,THTMID,THTMXD,NTHETA,
     &      PHIMID,PHIMXD,NPHI,NORI,IORTH
C
          RVAR1=QSCGSUM(1,1)/QSCSUM(1)
          WRITE(8,FMT=9050)QEXSUM(1),QABSUM(1),QSCSUM(1),RVAR1,
     &      QBKSUM(1),QPHSUM(1)
          IF(IORTH.EQ.1)THEN
              WRITE(8,FMT=9150)(QSCGSUM(J,1),J=1,3)
              IF(CMDTRQ.EQ.'DOTORQ')WRITE(8,
     &            FMT=9250)(QTRQABSUM(J,1),J=1,3),
     &            (QTRQSCSUM(J,1),J=1,3)
              WRITE(8,FMT=9060)
              DO 28 ND=1,NSCAT
C Convert scattering angles to degrees
                  PHIND=DEGRAD*PHIN(ND)
                  THETND=DEGRAD*THETAN(ND)
                  WRITE(8,FMT=9070)ND,THETND,PHIND,S1111(ND),
     &              S2121(ND),CX1121(ND)
   28         CONTINUE
C
C*** Write orientationally-averaged Q values (except Qpha) to 'qtable':
              OPEN(UNIT=10,FILE='qtable',STATUS='OLD')
              DO 31 ND=1,ILIN10
                  READ(10,FMT=*)
   31         CONTINUE
              RVAR1=QSCGSUM(1,1)/QSCSUM(1)
              WRITE(10,FMT=9056)AEFF,WAVE,QEXSUM(1),QABSUM(1),
     &          QSCSUM(1),RVAR1,QBKSUM(1)
              ILIN10=ILIN10+1
              CLOSE(10)
              OPEN(UNIT=12,FILE='qtable2',STATUS='OLD')
              DO 32 ND=1,ILIN12
                  READ(12,FMT=*)
   32         CONTINUE
              WRITE(12,FMT=9057)AEFF,WAVE,QPHSUM(1)
              ILIN12=ILIN12+1
              CLOSE(12)

          ELSE IF(IORTH.EQ.2)THEN
              RVAR1=QSCGSUM(1,2)/QSCSUM(2)
              QAV(1)=.5*(QEXSUM(1)+QEXSUM(2))
              QAV(2)=.5*(QABSUM(1)+QABSUM(2))
              QAV(3)=.5*(QSCSUM(1)+QSCSUM(2))
              QAV(4)=.5*(QSCGSUM(1,1)+QSCGSUM(1,2))/QAV(3)
              QAV(5)=.5*(QBKSUM(1)+QBKSUM(2))
              QAV(6)=.5*(QPHSUM(1)+QPHSUM(2))
              QAV(7)=QEXSUM(1)- QEXSUM(2)
              QAV(8)=QPHSUM(1)- QPHSUM(2)
              DO 38 J=1,3
                  QAV(8+J)=.5*(QSCGSUM(J,1)+QSCGSUM(J,2))
   38         CONTINUE
              IF(CMDTRQ.EQ.'DOTORQ')THEN
                  DO 41 J=1,3
                      QAV(11+J)=.5*(QTRQABSUM(J,1)+QTRQABSUM(J,2))
                      QAV(14+J)=.5*(QTRQSCSUM(J,1)+QTRQSCSUM(J,2))
   41             CONTINUE
              ENDIF

              WRITE(8,FMT=9055)QEXSUM(2),QABSUM(2),QSCSUM(2),RVAR1,
     &          QBKSUM(2),QPHSUM(2),(QAV(J),J=1,8)
              WRITE(8,FMT=9150)(QSCGSUM(J,1),J=1,3)
              WRITE(8,FMT=9155)(QSCGSUM(J,2),J=1,3),(QAV(J),J=9,11)
              IF(CMDTRQ.EQ.'DOTORQ')THEN
                  WRITE(8,FMT=9250)(QTRQABSUM(J,1),J=1,3),
     &              (QTRQSCSUM(J,1),J=1,3)
                  WRITE(8,FMT=9255)(QTRQABSUM(J,2),J=1,3),
     &              (QTRQSCSUM(J,2),J=1,3),(QAV(J),J=12,17)
              ENDIF
C
C*** Write orientationally-averaged Q values (except Qpha) to 'qtable':
              OPEN(UNIT=10,FILE='qtable',STATUS='OLD')
              DO 46 ND=1,ILIN10
                  READ(10,FMT=*)
   46         CONTINUE
              WRITE(10,FMT=9056)AEFF,WAVE,QAV(1),QAV(2),QAV(3),QAV(4),
     &          QAV(5)
              ILIN10=ILIN10+1
              CLOSE(10)
              OPEN(UNIT=12,FILE='qtable2',STATUS='OLD')
              DO 47 ND=1,ILIN12
                  READ(12,FMT=*)
   47         CONTINUE
              WRITE(12,FMT=9057)AEFF,WAVE,QAV(6),QAV(7),QAV(8)
              ILIN12=ILIN12+1
              CLOSE(12)
C
              WRITE(8,FMT=9080)
              DO 48 ND=1,NSCAT
C Convert scattering angles to degrees
                  PHIND=DEGRAD*PHIN(ND)
                  THETND=DEGRAD*THETAN(ND)
C Compute PPOL = degree of linear polarization of scattered light
C for incident unpolarized light (Bohren & Huffman p. 382)
                  PPOL=SQRT(SMORI(ND,2,1)**2+SMORI(ND,3,1)**2)/
     &                   SMORI(ND,1,1)
                  WRITE(8,FMT=9090)THETND,PHIND,SMORI(ND,1,1),
     &              SMORI(ND,2,1),SMORI(ND,3,1),SMORI(ND,4,1),
     &              SMORI(ND,1,2),SMORI(ND,1,3),PPOL

   48         CONTINUE

          ENDIF

          CLOSE(8)
      ENDIF

C write FORTRAN unformatted file
      IF(CBINFLAG.NE.'NOTBIN')THEN
          CALL WRITEBIN(CBINFLAG,CBINFILE,IOBIN,CSTAMP,CDESCR,CMDFFT,
     &                  CALPHA,CSHAPE,CMDTRQ,MXWAV,MXRAD,MXTHET,MXBETA,
     &                  MXPHI,MXN3,MXNAT,MXSCA,MXTIMERS,IORTH,NX,NY,NZ,
     &                  NAT0,NAT,NAT3,NSCAT,NCOMP,NORI,NWAV,NRAD,NTHETA,
     &                  NPHI,NBETA,NTIMERS,MXNX,MXNY,MXNZ,MXCOMP,
     &                  BETMID,BETMXD,THTMID,THTMXD,PHIMID,PHIMXD,ICTHM,
     &                  IPHIM,TOL,WAVEA,AEFFA,THETA,BETA,PHI,A1,A2,
     &                  ICOMP,IXYZ0,IWAV,IRAD,IORI,AEFF,WAVE,XX,AK1,
     &                  BETAD,THETAD,PHID,AKR,CXE01R,CXE02R,CXRFR,CXEPS,
     &                  QEXT,QABS,QSCAT,G,QBKSCA,QPHA,QAV,QTRQAB,QTRQSC,
     &                  SM,PHIN,THETAN,TIMERS)
C endif "if(cbinflag.ne.'NOTCDF') then"
      ENDIF

      IF(CNETFLAG.NE.'NOTCDF')THEN
          CALL WRITENET(CNETFILE,IDNC,CNETFLAG,CSTAMP,CDESCR,CMDFFT,
     &                  CALPHA,CSHAPE,CMDTRQ,MXWAV,MXRAD,MXTHET,MXBETA,
     &                  MXPHI,MXN3,MXNAT,MXSCA,MXTIMERS,IORTH,NX,NY,NZ,
     &                  NAT0,NAT,NAT3,NSCAT,NCOMP,NORI,NWAV,NRAD,NTHETA,
     &                  NPHI,NBETA,NTIMERS,MXNX,MXNY,MXNZ,MXCOMP,
     &                  BETMID,BETMXD,THTMID,THTMXD,PHIMID,PHIMXD,ICTHM,
     &                  IPHIM,TOL,WAVEA,AEFFA,THETA,BETA,PHI,A1,A2,
     &                  ICOMP,IXYZ0,IWAV,IRAD,ITHETA,IBETA,IPHI,IORI,
     &                  AEFF,WAVE,XX,AK1,BETAD,THETAD,PHID,AKR,CXE01R,
     &                  CXE02R,CXRFR,CXEPS,QEXT,QABS,QSCAT,G,QBKSCA,
     &                  QPHA,QAV,QTRQAB,QTRQSC,SM,SMORI,PHIN,THETAN,
     &                  TIMERS)
C endif "if(cnetflag.ne.'NOTCDF') then "
      ENDIF

      RETURN

 9030 FORMAT (' DDSCAT --- ',A,/,' TARGET ---',A,/,' ',A,
     &       ' --- method of solution ',/,' ',A,
     &       ' --- prescription for polarizabilies',/,' ',A,
     &       ' --- shape ',/,' NAT0 = ',I7,' = number of dipoles')
 9031 FORMAT (' n= (',F7.4,' , ',F7.4,'),  epsilon= (',F8.4,' , ',F7.4,
     &       ')  for material',I2)
 9032 FORMAT ('  AEFF=',F10.5,' =',' effective radius (physical units)',
     &       /,'  WAVE=',F10.5,' = wavelength (physical units)',/,
     &       '   K*A=',F10.5,' = 2*pi*aeff/lambda')
 9033 FORMAT ('   TOL=',1P,E10.3,' = error tolerance for CCG method',/,
     &       ' ICTHM=',I3,' = theta values used in comp. of Qsca,g',/,
     &       ' IPHIM=',I3,' = phi values used in comp. of Qsca,g',/,1X,
     &       0P,'(',F8.5,2F9.5,') = target axis A1 in Target Frame',/,
     &       1X,'(',F8.5,2F9.5,') = target axis A2 in Target Frame')
 9035 FORMAT (1X,'(',F8.5,2F9.5,') = k vector (latt. units) in TF',/,1X,
     &       3 ('(',F8.5,',',F8.5,')'),'=inc.pol.vec. 1 in TF',/,1X,
     &       3 ('(',F8.5,',',F8.5,')'),'=inc.pol.vec. 2 in TF')
 9037 FORMAT (1X,'(',F8.5,2F9.5,
     &       ') = k vector (latt. units) in Lab Frame',/,1X,
     &       3 ('(',F8.5,',',F8.5,')'),'=inc.pol.vec. 1 in LF',/,1X,
     &       3 ('(',F8.5,',',F8.5,')'),'=inc.pol.vec. 2 in LF')
 9040 FORMAT (' BETA =',F7.3,' = rotation of target around A1',/,
     &       ' THETA=',F7.3,' = angle between A1 and k',/,'  PHI =',
     &       F7.3,' = rotation of A1 around k')
 9042 FORMAT (2F8.3,' = beta_min, beta_max ;  NBETA =',I2,/,2F8.3,
     &       ' = theta_min, theta_max; NTHETA=',I2,/,2F8.3,
     &       ' = phi_min, phi_max   ;   NPHI =',I2,/,
     &       ' Results averaged over ',I3,' target orientations',/,
     &       '                   and ',I3,' incident polarizations')
 9050 FORMAT (10X,'Qext',6X,'Qabs',7X,'Qsca',5X,'g=<cos>',4X,'Qbk',7X,
     &       'Qpha',/,1X,'JO=1: ',1P,3E10.3,E11.3,2E10.3)
 9055 FORMAT (1X,'JO=2: ',1P,3E10.3,E11.3,2E10.3,/,1X,'mean: ',3E10.3,
     &       E11.3,2E10.3,/,1X,'Qpol= ',E10.3,35X,'dQpha=',E10.3)
 9056 FORMAT (1P,E10.4,E11.4,3E10.3,E11.3,E10.3)
 9057 FORMAT (1P,E10.4,E11.4,3E11.3)
 9060 FORMAT ('**** Selected scattering directions ',
     &       ' [note: incident pol state 1 is FIXED!]',/,
     &       ' ND THETA   PHI <|f11|^2> <|f21|^2> Re<f11*f21>',
     &       ' Im<f11*f21>')
 9070 FORMAT (I3,2F6.1,1P,2E10.3,2E11.3)
C 9080 FORMAT(' ***************** Selected scattering directions *****',
C     &       '************',/,
C     &       ' ND THETA   PHI <|f11|^2> <|f21|^2> <|f12|^2> ',
C     &       '<|f22|^2>  DEPOLR    PPOL')
 9080 FORMAT (12X,'** Mueller matrix elements for selected scattering ',
     &       'directions **',/,
     &       'theta   phi   S_11       S_21       S_31       S_41',
     &       '       S_12       S_13      Pol.')
 9090 FORMAT (F5.1,F6.1,1P,E10.3,1P,5E11.3,0P,F9.5)
 9150 FORMAT (8X,'Qsca*g(1)  Qsca*g(2)  Qsca*g(3)',/,1X,'JO=1:',1P,
     &       3E11.3)
 9155 FORMAT (1X,'JO=2:',1P,3E11.3,/,1X,'mean:',1P,3E11.3)
 9250 FORMAT (8X,'Qtrqab(1)  Qtrqab(2)  Qtrqab(3)  ',
     &       'Qtrqsc(1)  Qtrqsc(2)  Qtrqsc(3)',/,1X,'JO=1:',1P,6E11.3)
 9255 FORMAT (1X,'JO=2:',1P,6E11.3,/,1X,'mean:',1P,6E11.3)

      END

