      SUBROUTINE TARELL(A1,A2,AX,AY,AZ,DX,CDESCR,IOSHP,MXNAT,NAT,IXYZ,
     &                  ICOMP)
      IMPLICIT NONE
C** Arguments:
      CHARACTER CDESCR*67
      INTEGER IOSHP,MXNAT,NAT
      INTEGER*2 ICOMP(MXNAT,3),IXYZ(MXNAT,3)
      REAL AX,AY,AZ
      REAL A1(3),A2(3),DX(3)
C** Local variables:
      INTEGER JX,JY,JZ,LMX1,LMX2,LMY1,LMY2,LMZ1,LMZ2
      REAL AX2,AY2,AZ2,R,RYZ2,RZ2,X,XOFF,Y,YOFF,Z,ZOFF
C***********************************************************************
C Routine to construct ellipsoid from "atoms"
C Input:
C        AX=(x-length)/d    (d=lattice spacing)
C        AY=(y-length)/d
C        AZ=(z-length)/d
C        DX(1-3)=(dx,dy,dz)/d where dx,dy,dz=lattice spacings in x,y,z
C                directions, and d=(dx*dy*dz)**(1/3)=effective lattice
C                spacing
C        IOSHP=device number for "target.out" file
C             =-1 to suppress printing of "target.out"
C        MXNAT=dimensioning information (max number of atoms)
C Output:
C        A1(1-3)=(1,0,0)=unit vector defining target axis 1 in Target Frame
C        A2(1-3)=(0,1,0)=unit vector defining target axis 2 in Target Frame
C        NAT=number of atoms in target
C        IXYZ(1-NAT,1-3)=x/d,y/d,z/d for atoms of target
C        CDESCR=description of target (up to 67 characters)
C        ICOMP(1-NAT,1-3)=1 (composition identifier)

C B.T.Draine, Princeton Univ. Obs.
C History:
C 91.01.05 (BTD): Changed I4 -> I7 when printing NAT
C 91.04.22 (BTD): Added AX,AY,AZ and A1,A2 to WRITE(IOSHP,FMT=9020)
C 91.05.01 (BTD): TEMPORARY hack to be able to reproduce all arrays
C                 used by Draine 88 (in which XOFF=YOFF=ZOFF=0.5 always).
C 92.10.26 (BTD): Added code to set string CDESCR
C                 Added one call to WRIMSG
C 93.01.01 (BTD): Changed method for determining target axes A1, A2
C                 [previous criteria -- A1 = longest dimension,
C                 A2 = intermediate dimension -- created confusion]
C                 new rule: A1=(1,0,0), A2=(0,1,0)
C 93.03.12 (BTD): Changed CDESCR*(*) -> CDESCR*67
C 96.01.26 (BTD): Replaced IX,IY,IZ by IXYZ
C 97.11.02 (BTD): Added DX to argument list, and modified to allow use
C                 of noncubic lattice
C 98.02.11 (BTD): Modified to write DX to file "target.out"
C 00.10.19 (BTD): Corrected to reduce length of string written to
C                 CDESCR for ellipsoidal grain
C 00.11.02 (BTD): Add ICOMP to argument list, return ICOMP=1
C                 Write ICOMP to target.out
C end history
C
C Copyright (C) 1993,1996,1997,1998,2000 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************

C Routine to construct pseudo-ellipsoidal target aray.
C With occupied array sites contained within ellipsoidal surface
C defined by (X/AX*d)**2+(Y/AY*d)**2+(Z/AZ*d)**2=0.25
C Ideal volume V=(pi/6)*AX*AY*AZ*d**3
C where d = effective lattice spacing

C Dipoles are located on lattice at sites
C (x,y,z)=(I+XOFF,J+YOFF,Z+KOFF), I,J,K=integers
C                                 XOFF,YOFF,ZOFF=constants

C For sphere: call with AX=AY=AZ
C For spheroid: call with AX=AY (or AY=AZ or AX=AZ)
C B.T.Draine, Princeton Univ. Obs., 88.08.12

C Criterion for choosing XOFF:
C If AX is close to an even integer, take XOFF=1/2
C If AX is close to an odd integer, take XOFF=0

      JX=INT(AX/DX(1)+.5)
      IF(2*(JX/2).EQ.JX)THEN
         XOFF=0.5
      ELSE
         XOFF=0.
      ENDIF
C Similar criterion for YOFF:
      JY=INT(AY/DX(2)+.5)
      IF(2*(JY/2).EQ.JY)THEN
         YOFF=0.5
      ELSE
         YOFF=0.
      ENDIF
C Similar criterion for ZOFF:
      JZ=INT(AZ/DX(3)+.5)
      IF(2*(JZ/2).EQ.JZ)THEN
         ZOFF=0.5
      ELSE
         ZOFF=0.
      ENDIF

      LMX1=-INT(.5*AX/DX(1)+.5)
      LMX2=INT(.5*AX/DX(1)-.25)
      LMY1=-INT(.5*AY/DX(2)+.5)
      LMY2=INT(.5*AY/DX(2)-.25)
      LMZ1=-INT(.5*AZ/DX(3)+.5)
      LMZ2=INT(.5*AZ/DX(3)-.25)
      AX2=AX*AX
      AY2=AY*AY
      AZ2=AZ*AZ
      NAT=0

C Specify target axes A1 and A2
C Convention: A1=(1,0,0) in target frame
C             A2=(0,1,0) in target frame

      DO JX=1,3
         A1(JX)=0.
         A2(JX)=0.
      ENDDO
      A1(1)=1.
      A2(2)=1.

C Determine list of occupied sites.

      DO JZ=LMZ1,LMZ2
         Z=(REAL(JZ)+ZOFF)*DX(3)
         RZ2=Z*Z/AZ2
         IF(RZ2.LT.0.25)THEN
            DO JY=LMY1,LMY2
               Y=(REAL(JY)+YOFF)*DX(2)
               RYZ2=RZ2+Y*Y/AY2
               IF(RYZ2.LT.0.25)THEN
                  DO JX=LMX1,LMX2
                     X=(REAL(JX)+XOFF)*DX(1)
                     R=RYZ2+X*X/AX2
                     IF(R.LT.0.25)THEN
C Site is occupied:
                        NAT=NAT+1
                        IXYZ(NAT,1)=JX
                        IXYZ(NAT,2)=JY
                        IXYZ(NAT,3)=JZ
                     ENDIF
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
      ENDDO

      IF(NAT.GT.MXNAT)THEN
         CALL ERRMSG('FATAL','TARELL',' NAT.GT.MXNAT ')
      ENDIF

C Set composition

      DO JX=1,3
         DO JZ=1,NAT
            ICOMP(JZ,JX)=1
         ENDDO
      ENDDO

C***********************************************************************
C Write target description into string CDESCR
      IF(AX.EQ.AY.AND.AX.EQ.AZ)THEN
         WRITE(CDESCR,FMT='(A,I7,A,F6.3,F6.3,F6.3,A)')
     &         ' Sphere,',NAT,' dipoles,',
     &         DX(1),DX(2),DX(3),'=x,y,z lattice spacing'
      ELSE
         WRITE(CDESCR,FMT='(A,I7,A,F6.3,F6.3,F6.3,A)')
     &         ' Ellipsoid,',NAT,' dipoles,',
     &         DX(1),DX(2),DX(3),'=x,y,z lattice spacing'
      ENDIF
C***********************************************************************
      IF(IOSHP.GE.0)THEN
         OPEN(UNIT=IOSHP,FILE='target.out',STATUS='UNKNOWN')
         WRITE(IOSHP,FMT=9020)AX,AY,AZ,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(' >TARELL  ellipsoidal grain; AX,AY,AZ=',3F8.4,/,
     &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
