      SUBROUTINE TAR3EL(A1,A2,AX,AY,AZ,CDESCR,IOSHP,MXNAT,NAT,IXYZ)
C***********************************************************************
C Routine to construct three collinear touching ellipsoids from "atoms"
C Input:
C        AX=(x-length of one ellipsoid)/d    (d=lattice spacing)
C        AY=(y-length of one ellipsoid)/d
C        AZ=(z-length of one ellipsoid)/d
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 Note: atoms 1       - NAT/3   are in first ellipsoid
C             NAT/3+1 - 2*NAT/3 are in second ellipsoid
C             2*NAT/3+1 - NAT   are in third ellipsoid
C Ellipsoids are displaced from one another in x-direction
C First ellipsoid is at smallest x values, third at largest
C B.T.Draine, Princeton Univ. Obs.
C
C History:
C 93.01.20 (BTD) adapted from tar2el.f
C 93.03.12 (BTD) changed CDESCR*(*) -> CDESCR*67
C 96.01.26 (BTD) Replaced IX,IY,IZ by IXYZ
C end history
C
C Copyright (C) 1993,1996 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C
C** Arguments:
      CHARACTER CDESCR*67
      INTEGER IOSHP,MXNAT,NAT
      INTEGER*2 IXYZ(MXNAT,3)
      REAL AX,AY,AZ
      REAL A1(3),A2(3)
C** Local variables:
      CHARACTER CMSGNM*70
      INTEGER JA,JX,JXMAX,JXMIN,JY,JZ,LMX1,LMX2,LMY1,LMY2,LMZ1,LMZ2,NAT2
      REAL AX2,AY2,AZ2,R,RYZ2,RZ2,X,XOFF,Y,YOFF,Z,ZOFF
C***********************************************************************
C
C Routine to construct pseudo-ellipsoidal target aray.
C With occupied array sites contained within ellipsoidal surface
C defined by (X/AX)**2+(Y/AY)**2+(Z/AZ)**2=0.25
C Ideal volume V=(pi/6)*AX*AY*AZ
C
C Dipoles are located at sites
C (x,y,z)=(I+XOFF,J+YOFF,Z+KOFF), I,J,K=integers
C                                 XOFF,YOFF,ZOFF=constants
C
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/8/12
C
C
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
C
      JX=INT(AX+.5)
      IF(2*(JX/2).EQ.JX)THEN
         XOFF=0.5
      ELSE
         XOFF=0.
      ENDIF
C Similar criterion for YOFF:
      JY=INT(AY+.5)
      IF(2*(JY/2).EQ.JY)THEN
         YOFF=0.5
      ELSE
         YOFF=0.
      ENDIF
C Similar criterion for ZOFF:
      JZ=INT(AZ+.5)
      IF(2*(JZ/2).EQ.JZ)THEN
         ZOFF=0.5
      ELSE
         ZOFF=0.
      ENDIF
C
      LMX1=-INT(.5*AX+.5)
      LMX2=INT(.5*AX-.25)
      LMY1=-INT(.5*AY+.5)
      LMY2=INT(.5*AY-.25)
      LMZ1=-INT(.5*AZ+.5)
      LMZ2=INT(.5*AZ-.25)
      AX2=AX*AX
      AY2=AY*AY
      AZ2=AZ*AZ
      NAT=0
C
C Specify target axes A1 and A2
C Previous convention: A1 along longest dimension
C                      A2 along intermediate dimension
C New convention: A1=(1,0,0) in target frame
C                 A2=(0,1,0) in target frame
      DO 0010 JX=1,3
         A1(JX)=0.
         A2(JX)=0.
 0010 CONTINUE
      A1(1)=1.
      A2(2)=1.
C             
C Determine list of occupied sites in first ellipsoid
C
      JXMAX=LMX1
      JXMIN=LMX2
      DO 0300 JZ=LMZ1,LMZ2
         Z=REAL(JZ)+ZOFF
         RZ2=Z*Z/AZ2
         IF(RZ2.LT.0.25)THEN
            DO 0200 JY=LMY1,LMY2
               Y=REAL(JY)+YOFF
               RYZ2=RZ2+Y*Y/AY2
               IF(RYZ2.LT.0.25)THEN
                  DO 0100 JX=LMX1,LMX2
                     X=REAL(JX)+XOFF
                     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
                        IF(NAT.GT.1)THEN
                           IF(JX.GT.JXMAX)JXMAX=JX
                           IF(JX.LT.JXMIN)JXMIN=JX
                        ELSE
                           JXMAX=JX
                           JXMIN=JX
                        ENDIF
                     ENDIF
 0100             CONTINUE
               ENDIF
 0200       CONTINUE
         ENDIF
 0300 CONTINUE
C
C Now create duplicate second and third ellipsoids
      JXMAX=JXMAX-JXMIN+1
      DO 0400 JA=1,NAT
         IXYZ(NAT+JA,1)=IXYZ(JA,1)+JXMAX
         IXYZ(NAT+JA,2)=IXYZ(JA,2)
         IXYZ(NAT+JA,3)=IXYZ(JA,3)
         IXYZ(2*NAT+JA,1)=IXYZ(JA,1)+2*JXMAX
         IXYZ(2*NAT+JA,2)=IXYZ(JA,2)
         IXYZ(2*NAT+JA,3)=IXYZ(JA,3)
 0400 CONTINUE
      NAT=3*NAT
      IF(NAT.GT.MXNAT)THEN
         CALL ERRMSG('FATAL','TARELL',' NAT.GT.MXNAT ')
      ENDIF
C***********************************************************************
C Write target description into string CDESCR
      NAT2=NAT/3
      IF(AX.EQ.AY.AND.AX.EQ.AZ)THEN
         WRITE(CDESCR,FMT='(A,I7,A)')' Three spheres, each containing',
     &      NAT2,' dipoles'
      ELSE
         WRITE(CDESCR,FMT='(A,I7,A)')' Three ellipsoids, each ',
     &      'containing',NAT2,' dipoles'
      ENDIF
C***********************************************************************
      CMSGNM=CDESCR
      CALL WRIMSG('TARELL',CMSGNM)
      IF(IOSHP.GE.0)THEN
         OPEN(UNIT=IOSHP,FILE='target.out',STATUS='UNKNOWN')
         WRITE(IOSHP,FMT=9020)AX,AY,AZ,NAT,XOFF,YOFF,ZOFF,A1,A2
         DO 40 JX=1,NAT
            WRITE(IOSHP,FMT=9030)JX,IXYZ(JX,1),IXYZ(JX,2),IXYZ(JX,3)
   40    CONTINUE
         CLOSE(UNIT=IOSHP)
      ENDIF

      RETURN
 9020 FORMAT(' >TARELL  ellipsoidal grain; AX,AY,AZ=',3F8.4,/,
     &I7,3F8.4,' = NAT,XOFF,YOFF,ZOFF',/,
     &3F9.4,' = A_1 vector',/,
     &3F9.4,' = A_2 vector',/,
     &'     JA  IX  IY  IZ')
 9030 FORMAT(I7,3I4)
      END
