      SUBROUTINE 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***********************************************************************
C Subroutine  "writebin" writes FORTRAN unformatted binary file
C to file cbinfile ('dd.bin')
C
C Original version created by P.J.Flatau, University of California, SD
C History:
C 96.11.15 (PJF): First version.
C
C end history
C Copyright (C) 1996 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C
C     .. Scalar Arguments ..
      REAL AEFF,AK1,BETAD,BETMID,BETMXD,PHID,PHIMID,PHIMXD,THETAD,
     +     THTMID,THTMXD,TOL,WAVE,XX
      INTEGER ICTHM,IOBIN,IORI,IORTH,IPHIM,IRAD,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,CSHAPE*6,
     +          CBINFILE*14,CSTAMP*22,CDESCR*67
C     .. Array Arguments ..
      COMPLEX CXE01R(3),CXE02R(3),CXEPS(MXCOMP),CXRFR(MXCOMP)
      REAL A1(3),A2(3),AEFFA(MXRAD),AKR(3),BETA(MXBETA),G(2),PHI(MXPHI),
     +     PHIN(MXSCA),QABS(2),QAV(17),QBKSCA(2),QEXT(2),QPHA(2),
     +     QSCAT(2),QTRQAB(3,2),QTRQSC(3,2),SM(MXSCA,4,4),THETA(MXTHET),
     +     THETAN(MXSCA),TIMERS(MXTIMERS),WAVEA(MXWAV)
      INTEGER*2 ICOMP(MXN3),IXYZ0(MXNAT,3)
C     .. Local Scalars ..
      INTEGER I,IENTRY,IS,J
C     .. External Subroutines ..
      EXTERNAL WRIMSG
C     .. Data statements ..
      DATA IENTRY/0/

      IF (IENTRY.EQ.0) THEN
          CALL WRIMSG('WRITEBIN','First call to binary write')
          IENTRY = 1
C General run information:
          WRITE (IOBIN) CSTAMP,CDESCR,CMDFFT,CALPHA,CSHAPE,CMDTRQ
C mostly dimensions:
          WRITE (IOBIN) IORTH,NX,NY,NZ,NAT0,NAT,NAT3,NSCAT,NCOMP,NORI,
     +      NWAV,NRAD,NTHETA,NPHI,NBETA,NTIMERS
C maximum dimension (not really needed)
          WRITE (IOBIN) MXNX,MXNY,MXNZ,MXCOMP,MXSCA
          WRITE (IOBIN) BETMID,BETMXD,THTMID,THTMXD,PHIMID,PHIMXD
C dump scattering angles
          WRITE (IOBIN) (PHIN(I),I=1,NSCAT), (THETAN(I),I=1,NSCAT)
C misc run information
          WRITE (IOBIN) ICTHM,IPHIM,TOL
          WRITE (IOBIN) (WAVEA(I),I=1,NWAV), (AEFFA(I),I=1,NRAD),
     +      (THETA(I),I=1,NTHETA), (BETA(I),I=1,NBETA),
     +      (PHI(I),I=1,NPHI), (A1(I),I=1,3), (A2(I),I=1,3),
     +      (ICOMP(I),I=1,NAT3), (IXYZ0(I,1),I=1,NAT),
     +      (IXYZ0(I,2),I=1,NAT), (IXYZ0(I,3),I=1,NAT)

c endif  "if(cbinflag.eq.'USEBIN') then"
      END IF

C
C binary write of  for particular "iwav, irad, itheta, ibeta iphi"
C Let us try to keep only  one version of the binary file. Thus, in
C case of IORTH=1 or 'DOTORQ' some values are "missing"
C flatau -->draine  do we need smori for "ppol" do we need cxf_ij ?
C
      IF (IORI.NE.0 .AND. CBINFLAG.EQ.'ALLBIN') THEN
          WRITE (IOBIN) IWAV,IRAD,IORI, (TIMERS(I),I=1,NTIMERS)
          WRITE (IOBIN) AEFF,WAVE,XX,AK1,BETAD,THETAD,PHID,AKR,CXE01R,
     +      CXE02R, (CXRFR(I),I=1,NCOMP), (CXEPS(I),I=1,NCOMP)
          WRITE (IOBIN) QEXT,QABS,QSCAT,G,QBKSCA,QPHA,QAV,QTRQAB,QTRQSC
C write sm as 16 independent matrices (IDL handles 7 subscripts only)
          DO 10 I = 1,4
              DO 10 J = 1,4
                  WRITE (IOBIN) (SM(IS,I,J),IS=1,NSCAT)
   10     CONTINUE
C endif "if(iori. ne. 0 .and. cbinflag.eq.'ALLCDF') then"
      END IF

      IF (IORI.EQ.0) THEN
C iori=0 case
Cflatau ---> note. I need to add code for orientational averages
C but may be I can recalculate it from sm for iwav, irad, itheta,
C ---> dump weigths
      END IF

      RETURN

      END

