      SUBROUTINE REDUCE(CXV,IOCC,MXN3,MXNAT,NAT,NAT0)
      IMPLICIT NONE
C***********************************************************************
C Given:
C      CXV(1-3*NAT) defined for NAT lattice sites
C      IOCC(1-NAT) = 0 or 1 depending on whether lattice site
C                      is vacant or occupied
C      MXN3,MXNAT = dimensioning information
C      NAT = number of lattice sites
C      NAT0 = number of occupied lattice sites
C Returns
C      CXV(1-3*NAT0) defined for NAT0 occupied lattice sites
C
C Arguments:
      INTEGER MXN3,MXNAT,NAT,NAT0
      INTEGER*2 IOCC(MXNAT)
      COMPLEX CXV(MXN3)
C Local variables:
      INTEGER J,JOC,M
C
C B.T.Draine, Princeton Univ. Observatory, 90.11.29
C History:
C 90.12.03 (BTD): Modified for new ordering of vectors.
C 90.12.05 (BTD): Corrected errors
C
C Copyright (C) 1993, B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
      DO 20 M=0,2
         JOC=0
         DO 10 J=1,NAT
            IF(IOCC(J).GE.1)THEN
               JOC=JOC+1
               CXV(JOC+M*NAT0)=CXV(J+M*NAT)
            ENDIF
  10     CONTINUE
  20  CONTINUE
      RETURN
      END
