      SUBROUTINE WRITESCA(MXNX,MXNY,MXNZ,NX,NY,NZ,DX,ICOMP,
     &                    IXYZ0,MXNAT,MXN3,NAT,NAT3,WAVEA,MXWAV,NWAV,
     &                    AEFFA,MXRAD,NRAD,ITHETA,IBETA,IPHI,THETA,
     &                    MXTHET,NTHETA,BETA,MXBETA,NBETA,PHI,MXPHI,
     &                    NPHI,NSMELTS,TIMERS,MXTIMERS,NTIMERS,
     &                    CBINFILE,IOBIN,CBINFLAG,CNETFILE,IDNC,
     &                    CNETFLAG,ILIN10,ILIN12,IORI,IWRKSC,IORTH,
     &                    IRAD,IWAV,MXCOMP,MXSCA,NAT0,NAVG,ITNUM,
     &                    MXITER,NCOMP,NORI,NSCAT,CALPHA,CDESCR,CFLAVG,
     &                    CFLSCA,CMDFFT,CMDTRQ,CSHAPE,CSTAMP,AEFF,AK1,
     &                    AKR,BETAD,BETMID,BETMXD,ETASCA,PHID,PHIMID,
     &                    PHIMXD,THETAD,THTMID,THTMXD,TOL,WAVE,XX,A1,
     &                    A2,PHIN,QABS,QABSUM,QBKSCA,QBKSUM,QEXSUM,
     &                    QEXT,QPHA,QPHSUM,QSCAG,QSCAG2,QSCAT,QSCGSUM,
     &                    QSCG2SUM,QSCSUM,QTRQAB,QTRQABSUM,QTRQSC,
     &                    QTRQSCSUM,S1111,S2121,SM,SMIND1,SMIND2,SMORI,
     &                    THETAN,CX1121,CXE01,CXE01R,CXE02,CXE02R,
     &                    CXEPS,CXRFR,CXF11,CXF21,CXF12,CXF22)
C
      IMPLICIT NONE
C
C Scalar Arguments ..
C
      REAL AEFF,AK1,BETAD,BETMID,BETMXD,ETASCA,PHID,PHIMID,PHIMXD,
     &     THETAD,THTMID,THTMXD,TOL,WAVE,XX
      INTEGER IBETA,IDNC,ILIN10,ILIN12,IOBIN,IORI,IORTH,IPHI,
     &        IRAD,ITHETA,IWAV,IWRKSC,MXBETA,MXCOMP,MXITER,MXN3,MXNAT,
     &        MXNX,MXNY,MXNZ,MXPHI,MXRAD,MXSCA,MXTHET,MXTIMERS,MXWAV,
     &        NAT,NAT0,NAT3,NAVG,NBETA,NCOMP,NORI,NPHI,NRAD,NSCAT,
     &        NSMELTS,NTHETA,NTIMERS,NWAV,NX,NY,NZ
      
      INTEGER ITNUM(2)
      CHARACTER CALPHA*6,CBINFLAG*6,CMDFFT*6,CMDTRQ*6,CNETFLAG*6,
     &          CSHAPE*6,CFLAVG*14,CBINFILE*14,CFLSCA*15,CNETFILE*14,
     &          CSTAMP*22,CDESCR*67
C
C Array Arguments ..
C
      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),DX(3),
     &     PHI(MXPHI),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),
     &     THETA(MXTHET),THETAN(MXSCA),TIMERS(MXTIMERS),WAVEA(MXWAV)
      INTEGER*2 ICOMP(MXN3),IXYZ0(MXNAT,3)
      INTEGER SMIND1(9),SMIND2(9)

C Local variables:

      COMPLEX CXVAR1
      REAL DEGRAD,MKD,PHIND,PI,PPOL,RVAR1,RVAR2,RVAR3,THETND
      INTEGER I,J,ND
      REAL G(2),G2(2),QAV(18)

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 If IORI = 0, then print orientational average
C If IORI > 0, print output for specific orientation
C
C History:
C 96.11.14 (PJF) added binary write options (see also info in
C                "versions.f" about IDL postprocessing)
C                possible "checkpointing" 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.01.11 (BTD) added DX(3) to argument list to pass information on
C                nonuniform lattice spacing [development of DDSCAT.6.0]
C 98.11.16 (BTD) corrected CX01R -> CXE01R in argument list of WRITEBIN
C 98.12.12 (BTD) Introduce NSMELTS,SMIND1,SMIND2 to argument list to
C                allow selection of Muller matrix elements to be
C                printed out.  Add code to allow from 1 to 9 matrix
C                elements to be printed.
C 98.12.13 (BTD) Modify to print out validity criterion |m|kd
C                for each composition
C 03.01.30 (BTD) disabled output line to print out dx,dy,dz
C 03.02.13 (BTD) added one more digit of precision to output Q values
C                with appropriate modifications to format statements
C 03.04.14 (BTD) added ITNUM(2) and MXITER to argument list
C                added ITNUM(2) = number of iterations
C                and MXITER = max number of iterations allowed
C                to output statements 9150 and 9155
C 03.09.01 (BTD) cosmetic change to output statement: g -> g(1)
C 03.10.23 (BTD) removed ICTHM and IPHIM from argument list
c                removed ICTHM and IPHIM from argument list of
c                WRITENET and WRITEBIN
c                removed ICTHM and IPHIM from WRITE(..,9033)
c                added NAVG to argument list
c                added NAVG to WRITE(..,9033)
c                added NAVG to argument list of WRITENET and WRITEBIN
c                write NAVG to qtable,wxxrxxkxxx.sca, wxxrxxori.avg
C 04.02.22 (BTD) added IWRKSC to argument list of WRITESCA and use to
c                control writing to ascii output files
c 04.05.21 (BTD) reordered QSCGSUM and QSCG2SUM in argument list
c 04.12.29 (BTD) corrected error in writing Mueller matrix for the
c                "sca" files when IWRKSC=1
c 05.10.11 (BTD) changed CFLAVG*13 to CFLAVG*14
c                changed CFLSCA*14 to CFLSCA*15
c 06.11.28 (BTD) corrected error in calculation of PPOL = degree of
c                linear polarization of scattered light
C end history
C
C Copyright (C) 1996,1998,2003,2004,2005,2006
C               B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************

C If CNETFLAG = 'NCCLOS' then call WRITENET 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,NAVG,NSCAT,NCOMP,NORI,
     &                 NWAV,NRAD,NTHETA,NPHI,NBETA,NTIMERS,MXNX,MXNY,
     &                 MXNZ,MXCOMP,BETMID,BETMXD,THTMID,THTMXD,
     &                 PHIMID,PHIMXD,TOL,DX,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,
c btd 04.02.22 add next two lines
     &                 QEXSUM,QABSUM,QSCSUM,QBKSUM,QPHSUM,QSCGSUM,
     &                 QTRQABSUM,QTRQSCSUM,
c ---------------
     &                 PHIN,THETAN,TIMERS)
         RETURN
      ENDIF

C If IORI > 0, then write out scattering properties for this specific
C target orientation.

      PI=4.*ATAN(1.)
      IF(IORI.GT.0)THEN

C*** Compute G=<cos(theta)> and G2=<cos^2(theta)>

         DO J=1,IORTH
            G(J)=QSCAG(1,J)/QSCAT(J)
            G2(J)=QSCAG2(J)/QSCAT(J)
         ENDDO

         IF(IWRKSC.EQ.1)THEN

            CALL NAMER(IWAV,IRAD,IORI,CFLSCA,CFLAVG)
            OPEN(UNIT=8,FILE=CFLSCA,STATUS='UNKNOWN')
            WRITE(8,FMT=9030)CSTAMP,CDESCR,CMDFFT,CALPHA,CSHAPE,NAT0

C following code to be enabled for noncubic treatment:
C     &         ,DX

            WRITE(8,FMT=9032)AEFF,WAVE,XX
            DO J=1,NCOMP
               MKD=(4.*PI/(3.*NAT0))**(1./3.)*
     &             SQRT(REAL(CXRFR(J)*CONJG(CXRFR(J))))*XX
               WRITE(8,FMT=9031)CXRFR(J),CXEPS(J),MKD,J
            ENDDO
            WRITE(8,FMT=9033)TOL,NAVG,A1,A2
            WRITE(8,FMT=9035)AKR,CXE01R,CXE02R
            WRITE(8,FMT=9040)BETAD,THETAD,PHID,ETASCA
            WRITE(8,FMT=9050)QEXT(1),QABS(1),QSCAT(1),G(1),G2(1),
     &                       QBKSCA(1),QPHA(1)
         ENDIF

         IF(IORTH.EQ.1)THEN

C Assign "missing value" value if there is only one polarization

            DO I=1,18
               QAV(I)=-999.
            ENDDO
            QEXT(2)=-999.
            QABS(2)=-999.
            QSCAT(2)=-999.
            QBKSCA(2)=-999.
            QPHA(2)=-999.
            G(2)=-999.
            G2(2)=-999.
            DO J=1,3
               QSCAG(J,2)=-999.
            ENDDO
            QSCAG2(2)=-999.
         ENDIF

         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*(QSCAG2(1)+QSCAG2(2))/QAV(3)
            QAV(6)=.5*(QBKSCA(1)+QBKSCA(2))
            QAV(7)=.5*(QPHA(1)+QPHA(2))
            QAV(8)=QEXT(1)-QEXT(2)
            QAV(9)=QPHA(1)-QPHA(2)
            DO J=1,3
               QAV(9+J)=.5*(QSCAG(J,1)+QSCAG(J,2))
            ENDDO
            IF(CMDTRQ.EQ.'DOTORQ')THEN
               DO J=1,3
                  QAV(12+J)=.5*(QTRQAB(J,1)+QTRQAB(J,2))
                  QAV(15+J)=.5*(QTRQSC(J,1)+QTRQSC(J,2))
               ENDDO
            ENDIF
            IF(IWRKSC.EQ.1)WRITE(8,FMT=9055)QEXT(2),QABS(2),QSCAT(2),
     &                     G(2),G2(2),QBKSCA(2),QPHA(2),(QAV(J),J=1,9)
         ENDIF

         IF(IWRKSC.EQ.1)THEN
            WRITE(8,FMT=9150)(QSCAG(J,1),J=1,3),ITNUM(1),MXITER,NAVG
            IF(IORTH.EQ.2)THEN
               WRITE(8,FMT=9155)(QSCAG(J,2),J=1,3),ITNUM(2),MXITER,NAVG,
     &                          (QAV(J),J=10,12)
            ENDIF
         ENDIF

         IF(CMDTRQ.EQ.'DOTORQ')THEN
            IF(IWRKSC.EQ.1)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=13,18)
            ENDIF
         ELSE

C add missing value code (set to -999.)

            DO I=1,3
               DO J=1,2
                  QTRQAB(I,J)=-999.
                  QTRQSC(I,J)=-999.
               ENDDO
            ENDDO

         ENDIF

         IF(IORTH.EQ.1)THEN

            IF(IWRKSC.EQ.1)WRITE(8,FMT=9060)
            DO ND=1,NSCAT

C convert scattering angles to degrees

               PHIND=DEGRAD*PHIN(ND)
               THETND=DEGRAD*THETAN(ND)
               RVAR1=REAL(CONJG(CXF11(ND))*CXF11(ND))
               RVAR2=REAL(CONJG(CXF21(ND))*CXF21(ND))
               CXVAR1=CONJG(CXF11(ND))*CXF21(ND)
               IF(IWRKSC.EQ.1)
     &            WRITE(8,FMT=9070)ND,THETND,PHIND,RVAR1,RVAR2,CXVAR1
            ENDDO

         ELSEIF(IORTH.EQ.2)THEN
            IF(IWRKSC.EQ.1)THEN
               WRITE(8,FMT=9080)
               IF(NSMELTS.EQ.1)THEN
                  WRITE(8,FMT=9081)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.2)THEN
                  WRITE(8,FMT=9082)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.3)THEN
                  WRITE(8,FMT=9083)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.4)THEN
                  WRITE(8,FMT=9084)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.5)THEN
                  WRITE(8,FMT=9085)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.6)THEN
                  WRITE(8,FMT=9086)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.7)THEN
                  WRITE(8,FMT=9087)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.8)THEN
                  WRITE(8,FMT=9088)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ELSEIF(NSMELTS.EQ.9)THEN
                  WRITE(8,FMT=9089)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
               ENDIF

               DO 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
c---
c 061128 (BTD) correct error in calculation of PPOL
c                  PPOL=SQRT(SM(ND,2,1)**2+SM(ND,3,1)**2)/SM(ND,1,1)
                  PPOL=-SM(ND,1,2)/SM(ND,1,1)
c---
                  WRITE(8,FMT=9090)THETND,PHIND,PPOL,
c*** 
c 04.12.29 (BTD) correction
c    &                 (SMORI(ND,SMIND1(J),SMIND2(J)),J=1,NSMELTS)
     &                 (SM(ND,SMIND1(J),SMIND2(J)),J=1,NSMELTS)
c***
               ENDDO
            ENDIF
         ENDIF

         IF(IWRKSC.EQ.1)CLOSE(8)

      ELSE

C This module writes out results from orientational averaging.
C (arrive here when called with IORI=0)

         OPEN(UNIT=8,FILE=CFLAVG,STATUS='UNKNOWN')
         WRITE(8,FMT=9030)CSTAMP,CDESCR,CMDFFT,CALPHA,CSHAPE,NAT0

C following code to be enabled for noncubic treatment:
C         WRITE(8,FMT=9030)CSTAMP,CDESCR,CMDFFT,CALPHA,CSHAPE,NAT0,DX

         WRITE(8,FMT=9032)AEFF,WAVE,XX
         DO J=1,NCOMP
             MKD=(4.*PI/(3.*NAT0))**(1./3.)*
     &           SQRT(REAL(CXRFR(J)*CONJG(CXRFR(J))))*XX
            WRITE(8,FMT=9031)CXRFR(J),CXEPS(J),MKD,J
         ENDDO
         WRITE(8,FMT=9033)TOL,NAVG,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,ETASCA,NORI,IORTH

         RVAR1=QSCGSUM(1,1)/QSCSUM(1)
         RVAR2=QSCG2SUM(1)/QSCSUM(1)
         WRITE(8,FMT=9050)QEXSUM(1),QABSUM(1),QSCSUM(1),RVAR1,RVAR2,
     &                    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 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)
            ENDDO

C Write orientationally-averaged Q values (except Qpha) to 'qtable':

            OPEN(UNIT=10,FILE='qtable',STATUS='OLD')
            DO ND=1,ILIN10
               READ(10,FMT=*)
            ENDDO
            RVAR1=QSCGSUM(1,1)/QSCSUM(1)
            RVAR2=QSCG2SUM(1)/QSCSUM(1)
            WRITE(10,FMT=9056)AEFF,WAVE,QEXSUM(1),QABSUM(1),QSCSUM(1),
     &                        RVAR1,RVAR2,QBKSUM(1),NAVG
            ILIN10=ILIN10+1
            CLOSE(10)
            OPEN(UNIT=12,FILE='qtable2',STATUS='OLD')
            DO ND=1,ILIN12
               READ(12,FMT=*)
            ENDDO
            WRITE(12,FMT=9057)AEFF,WAVE,QPHSUM(1)
            ILIN12=ILIN12+1
            CLOSE(12)

         ELSEIF(IORTH.EQ.2)THEN
            RVAR1=QSCGSUM(1,2)/QSCSUM(2)
            RVAR2=QSCG2SUM(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*(QSCG2SUM(1)+QSCG2SUM(2))/QAV(3)
            QAV(6)=.5*(QBKSUM(1)+QBKSUM(2))
            QAV(7)=.5*(QPHSUM(1)+QPHSUM(2))
            QAV(8)=QEXSUM(1)-QEXSUM(2)
            QAV(9)=QPHSUM(1)-QPHSUM(2)
            DO J=1,3
               QAV(9+J)=.5*(QSCGSUM(J,1)+QSCGSUM(J,2))
            ENDDO
            IF(CMDTRQ.EQ.'DOTORQ')THEN
               DO J=1,3
                  QAV(12+J)=.5*(QTRQABSUM(J,1)+QTRQABSUM(J,2))
                  QAV(15+J)=.5*(QTRQSCSUM(J,1)+QTRQSCSUM(J,2))
               ENDDO
            ENDIF
            RVAR2=.5*(QSCG2SUM(1)+QSCG2SUM(2))/QAV(3)
            WRITE(8,FMT=9055)QEXSUM(2),QABSUM(2),QSCSUM(2),RVAR1,RVAR2,
     &                       QBKSUM(2),QPHSUM(2),(QAV(J),J=1,9)
            WRITE(8,FMT=9150)(QSCGSUM(J,1),J=1,3),ITNUM(1),MXITER,NAVG
            WRITE(8,FMT=9155)(QSCGSUM(J,2),J=1,3),ITNUM(2),MXITER,NAVG,
     &                       (QAV(J),J=10,12)
            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=13,18)
            ENDIF

C Write orientationally-averaged Q values (except Qpha) to 'qtable':

            OPEN(UNIT=10,FILE='qtable',STATUS='OLD')
            DO ND=1,ILIN10
               READ(10,FMT=*)
            ENDDO
            WRITE(10,FMT=9056)AEFF,WAVE,QAV(1),QAV(2),QAV(3),QAV(4),
     &                        QAV(5),QAV(6),NAVG
            ILIN10=ILIN10+1
            CLOSE(10)
            OPEN(UNIT=12,FILE='qtable2',STATUS='OLD')
            DO ND=1,ILIN12
               READ(12,FMT=*)
            ENDDO
            WRITE(12,FMT=9057)AEFF,WAVE,QAV(7),QAV(8),QAV(9)
            ILIN12=ILIN12+1
            CLOSE(12)
C
            WRITE(8,FMT=9080)
            IF(NSMELTS.EQ.1)THEN
               WRITE(8,FMT=9081)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.2)THEN
               WRITE(8,FMT=9082)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.3)THEN
               WRITE(8,FMT=9083)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.4)THEN
               WRITE(8,FMT=9084)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.5)THEN
               WRITE(8,FMT=9085)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.6)THEN
               WRITE(8,FMT=9086)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.7)THEN
               WRITE(8,FMT=9087)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.8)THEN
               WRITE(8,FMT=9088)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ELSEIF(NSMELTS.EQ.9)THEN
               WRITE(8,FMT=9089)(SMIND1(J),SMIND2(J),J=1,NSMELTS)
            ENDIF
            DO 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)
c---
c 061128 (BTD) correct error in calculation of PPOL
c               PPOL=SQRT(SMORI(ND,2,1)**2+SMORI(ND,3,1)**2)/
c     &                   SMORI(ND,1,1)
               PPOL=-SMORI(ND,1,2)/SMORI(ND,1,1)
c---
               WRITE(8,FMT=9090)THETND,PHIND,PPOL,
     &              (SMORI(ND,SMIND1(J),SMIND2(J)),J=1,NSMELTS)
            ENDDO

         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,NAVG,NSCAT,NCOMP,NORI,
     &                 NWAV,NRAD,NTHETA,NPHI,NBETA,NTIMERS,MXNX,MXNY,
     &                 MXNZ,MXCOMP,BETMID,BETMXD,THTMID,THTMXD,
     &                 PHIMID,PHIMXD,TOL,DX,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)

      ENDIF

c btd 04.02.22 change
c add following to WRITENET argument list:
c QEXSUM
c QABSUM
c QSCSUM
c QBKSUM
c QPHSUM
c QSCGSUM
c QTRQABSUM
c QTRQSCSUM

      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,NAVG,NSCAT,NCOMP,NORI,
     &                 NWAV,NRAD,NTHETA,NPHI,NBETA,NTIMERS,MXNX,MXNY,
     &                 MXNZ,MXCOMP,BETMID,BETMXD,THTMID,THTMXD,
     &                 PHIMID,PHIMXD,TOL,DX,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,
c btd 04.02.22 add next two lines
     &                 QEXSUM,QABSUM,QSCSUM,QBKSUM,QPHSUM,QSCGSUM,
     &                 QTRQABSUM,QTRQSCSUM,
c--------------------------------
     &                 PHIN,THETAN,TIMERS)
      ENDIF

      RETURN

 9030 FORMAT(' DDSCAT --- ',A,/,' TARGET ---',A,/,' ',A,
     &       ' --- method of solution ',/,' ',A,
     &       ' --- prescription for polarizabilies',/,' ',A,
     &       ' --- shape ',/,I7,' = NAT0 = number of dipoles')
c following code to be enabled for noncubic treatment
c 9030 FORMAT(' DDSCAT --- ',A,/,' TARGET ---',A,/,' ',A,
c     &       ' --- method of solution ',/,' ',A,
c     &       ' --- prescription for polarizabilies',/,' ',A,
c     &       ' --- shape ',/,I7,' = NAT0 = number of dipoles',
C     &       3F8.5,' = normalized lattice spacings dx,dy,dz')
 9031 FORMAT('n= (',F7.4,' , ',F7.4,'),  eps.= (',F8.4,' , ',F7.4,
     &       ')  |m|kd=',0PF8.4,' for subs.',I2)
 9032 FORMAT('  AEFF=',F10.5,' =',' effective radius (physical units)',
     &       /,'  WAVE=',F10.5,' = wavelength (physical units)',/,
     &       'K*AEFF=',F10.5,' = 2*pi*aeff/lambda')
 9033 FORMAT('   TOL=',1P,E10.3,' = error tolerance for CCG method',/,
     &       '  NAVG=',I6,
     &       ' = (theta,phi) values used in comp. of Qsca,g',/,
     &       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',/,
     &       F7.4,' = ETASCA = param. controlling # of ',
     &       'scatt. dirs used to calculate <cos> etc.')
 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,/,
     &       F7.4,' = ETASCA = param. controlling # of ',
     &       'scatt. dirs used to calculate <cos> etc.',/,
     &       ' Results averaged over ',I4,' target orientations',/,
     &       '                   and ',I2,' incident polarizations')
 9050 FORMAT(10X,'Qext',7X,'Qabs',7X,'Qsca',6X,'g(1)=<cos>',2X,
     &       '<cos^2>',5X,'Qbk',7X,
     &       'Qpha',/,1X,'JO=1: ',1P,3E11.4,E12.4,2E11.4,E12.4)
 9055 FORMAT(1X,'JO=2: ',1P,3E11.4,E12.4,2E11.4,E12.4,/,1X,'mean: ',
     &       3E11.4,E12.4,2E11.4,E12.4,/,1X,'Qpol= ',E11.4,50X,'dQpha=',
     &       E12.4)
 9056 FORMAT(1P,E10.4,4E11.4,E12.4,E11.4,E11.4,I6)
 9057 FORMAT(1P,E10.4,E11.4,3E12.4)
 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 **')
 9081 FORMAT('theta   phi    Pol.    S_',I1,I1)
 9082 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1)
 9083 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1)
 9084 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1)
 9085 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1)
 9086 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1)
 9087 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1)
 9088 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1)
 9089 FORMAT('theta   phi    Pol.    S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1,7X,
     &       'S_',I1,I1,7X,'S_',I1,I1,7X,'S_',I1,I1)
 9090 FORMAT(F5.1,F6.1,F9.5,1P,9E11.3)
 9150 FORMAT(9X,'Qsca*g(1)   Qsca*g(2)   Qsca*g(3)   iter  mxiter',
     &       2X,'Nsca'/,
     &       1X,'JO=1:',1P,3E12.4,3I7)
 9155 FORMAT(1X,'JO=2:',1P,3E12.4,3I7,/,1X,'mean:',1P,3E12.4)
 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

