      SUBROUTINE TARBLOCKS(A1,A2,DX,NBLOCKS,BLKSIZ,XYZB,IPRINAX,IOSHP,
     &                     CDESCR,MXNAT,NAT,IXYZ,ICOMP)
      IMPLICIT NONE

C Arguments:

      INTEGER BLKSIZ,IPRINAX,NBLOCKS,IOSHP,MXNAT,NAT
      INTEGER*2 IXYZ(MXNAT,3),ICOMP(MXNAT,3)
      INTEGER XYZB(3,100)
      REAL A1(3),A2(3),DX(3)
      CHARACTER CDESCR*67

C Local variables:

      INTEGER JB,JD,JJX,JJY,JJZ,JOFF,JOFFX,JOFFY,JOFFZ,JX,JY,JZ
      REAL EIGVAL(3)

C***********************************************************************
C
C Subroutine to construct a target out of "cubic" blocks.
C Blocks are only cubic for case of a cubic lattice DX=(1.,1.,1.)
C In case of a noncubic lattice, "blocks" are rectangular, with an equal
C number (=BLKSIZ) of dipole spacings in each direction.
C
C Given:
C DX(1-3)     =(dx/d,dy/d,dz/d) where dx,dy,dz = x,y,z lattice spacing,
C              and d = (dx*dy*dz)**(1/3) = effective lattice spacing
C NBLOCKS     =number of cubic blocks in target
C BLKSIZ      =(integer) ratio of block width/dipole spacing
C              (there will be BLKSIZ**3 dipoles per block)
C XYZB(1-3,J) =x,y,z coordinates of block a, in units of block width
C IPRINAX     =0. to return A1=(1,0,0), A2=(0,1,0)
C             =1. to return A1,A2=principal axes with largest, 2nd largest
C              moment of inertia
C IOSHP       =device number for output file "target.out"
C             =-1 to suppress generation of file "target.out"
C MXNAT       =limit on largest allowed value of NAT=number of dipoles
C
C Returns:
C NAT         =number of dipoles in target
C IXYZ(J,1-3) =x,y,z location of dipole J on lattice
C ICOMP(J,1-3)=composition for dipole J; x,y,z directions
C A1(1-3)     =principal axis A1 in target frame (normalized)
C A2(1-3)     =principal axis A2 in target frame (normalized)
C CDESCR      =string describing target
C
C where A1 = principal axis with largest moment of inertia
C       A2 = principal axis with second-largest moment of inertia
C
C B.T. Draine, Princeton Univ. Observatory, 95.12.11
C History:
C 96.01.02 (BTD) modified to compute eigenvalues and eigenvectors of
C                moment of inertia tensor, and to define vectors A1 and 
C                A2 to be along eigenvectors with largest and second
C                largest eigenvalues, respectively.
C 96.01.26 (BTD) Replaced IX,IY,IZ by IXYZ
C                Removed principal axis calculation to separate
C                subroutine PRINAXIS
C 96.01.29 (BTD) Added variable IPRINAX to allow control over definition
C                of axes A1,A2
C 96.02.23 (BTD) Remove computation of principal axes and eigenvalues
C                as this is now carried out by routine PRINAXIS.
C 97.12.26 (BTD) Add DX(3) to argument list to support nonuniform
C                lattice spacing.
C                Add DX to argument list of PRINAXIS.
C 98.03.07 (BTD) Add DX to file target.out for compatibility with
C                new version of REASHP
C 03.11.06 (BTD) Modified to use new version of PRINAXIS with eigenvalues
C                in argument list
C 04.03.19 (BTD) Revert to previous version of PRINAXIS
C 04.05.23 (BTD) Added EIGVAL to argument list of PRINAXIS to conform
C                to change in PRINAXIS
C End history.
C Copyright (C) 1996,1997,1998,2003,2004 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************

C For the moment, let us assume that blocks do not overlap.

      JOFF=1-((BLKSIZ+1)/2)
      JD=0
      DO JB=1,NBLOCKS
         JOFFX=JOFF+BLKSIZ*XYZB(1,JB)
         JOFFY=JOFF+BLKSIZ*XYZB(2,JB)
         JOFFZ=JOFF+BLKSIZ*XYZB(3,JB)
         DO JX=1,BLKSIZ
            JJX=JX+JOFFX
            DO JY=1,BLKSIZ
               JJY=JY+JOFFY
               DO JZ=1,BLKSIZ
                  JJZ=JZ+JOFFZ
                  JD=JD+1
                  IXYZ(JD,1)=JJX
                  IXYZ(JD,2)=JJY
                  IXYZ(JD,3)=JJZ

C Homogeneous target:

                  ICOMP(JD,1)=1
                  ICOMP(JD,2)=1
                  ICOMP(JD,3)=1
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      NAT=JD

      IF(IPRINAX.NE.0)THEN

C Call PRINAXIS to compute principal axes

         CALL PRINAXIS(MXNAT,NAT,ICOMP,IXYZ,DX,A1,A2,EIGVAL)
      ELSE

C Do not compute principal axes: simply set 
C a1=(1,0,0) and a2=(0,1,0) in target frame.

         A1(1)=1.
         A1(2)=0.
         A1(3)=0.
         A2(1)=0.
         A2(2)=1.
         A2(3)=0.

      ENDIF

C***********************************************************************
C Write target description into string CDESCR
C Note: this will replace whatever CDESCR was read in from the
C 'blocks.par' file. If you want to retain that description,
C then comment out the following statement:
C      WRITE(CDESCR,FMT='(A,I7,A,I3,A)')'Target containing',
C     &      NAT,' dipoles arranged in ',NBLOCKS,' cubic blocks'
C***********************************************************************

      IF(IOSHP.GE.0)THEN
         OPEN(UNIT=IOSHP,FILE='target.out',STATUS='UNKNOWN')
         WRITE(IOSHP,FMT=9020)NAT,A1,A2,DX
         DO JX=1,NAT
            WRITE(IOSHP,FMT=9030)JX,IXYZ(JX,1),IXYZ(JX,2),IXYZ(JX,3),
     &                           ICOMP(JX,1),ICOMP(JX,2),ICOMP(JX,3)
         ENDDO
         CLOSE(UNIT=IOSHP)
      ENDIF   
      RETURN
 9020 FORMAT(' >TARBLOCKS: cubic building blocks',/,
     &I7,' = NAT',/,
     &3F9.4,' = A_1 vector',/,
     &3F9.4,' = A_2 vector',/,
     &3F9.6,' = lattice spacings (d_x,d_y,d_z)/d',/,
     &'     JA  IX  IY  IZ ICOMP(x,y,z)')
 9030 FORMAT(I7,3I4,3I2)
      END
