      SUBROUTINE TARCEL(A1,A2,AX,AY,AZ,BX,BY,BZ,DX,
     &                  CDESCR,IOSHP,MXNAT,NAT,IXYZ,ICOMP)
      IMPLICIT NONE
C** Arguments:
      CHARACTER CDESCR*67
      INTEGER IOSHP,MXNAT,NAT
      INTEGER*2 IXYZ(MXNAT,3),ICOMP(MXNAT,3)
      REAL AX,AY,AZ,BX,BY,BZ
      REAL A1(3),A2(3),DX(3)
C** Local variables:
      INTEGER JX,JY,JZ,LMX1,LMX2,LMY1,LMY2,LMZ1,LMZ2,NIN
      REAL AX2,AY2,AZ2,BX2,BY2,BZ2,R,RR,RYZ2,RZ2,X,XOFF,Y,YOFF,Z,ZOFF
C***********************************************************************
C
C Routine to construct target consisting of two materials, with outer
C surface an allipsoid of dimensions AX,AY,AZ,
C and core/mantle interface a concentric ellipsoid of dimensions BX,BY,BZ
C Input:
C        AX=(x-length)/d of outer ellipsoid  (d=lattice spacing)
C        AY=(y-length)/d "   "     "
C        AZ=(z-length)/d "   "     "
C        BX=(x-length)/d of inner ellipsoid
C        BY=(y-length)/d "   "     "
C        BZ=(z-length)/d "   "     "
C        DX(1-3)=lattice spacing (dx/d,dy/d,dz/d), d=(dx*dy*dz)**(1/3)
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        ICOMP(1-NAT,1-3)=1 for sites within inner ellipsoid,
C                        =2 for sites between inner and outer ellipsoids
C        CDESCR=description of target (up to 67 characters)
C
C B.T.Draine, Princeton Univ. Obs.
C History:
C 94.01.26 (AP) : Adapted from TARELL by Antonio Peimbert, Princeton U.
C 94.01.27 (BTD): Modified for compatibility with TARGET, using
C                 AX,AY,AZ,BX,BY,BZ to transfer shape parameters read by
C                 subroutine REAPAR
C 94.03.21 (BTD): Corrected format statement
C 96.01.26 (BTD): Replaced IX,IY,IZ by IXYZ
C 97.12.26 (BTD): Added DX(3) to argument list to support nonuniform
C                 lattice spacing.
C                 *** Note: additional code modifications required
C                     to support noncubic lattice!
C 98.03.06 (BTD): If called with noncubic lattice (not yet supported)
C                 call ERRMSG and halt with fatal error.
C 98.03.07 (BTD): Modify to write DX to file "target.out" for
C                 compatibility with REASHP
C 00.11.02 (BTD): Remove XOFF,YOFF,ZOFF from target.out
C                 cosmetic changes
C end history
C
C Copyright (C) 1994,1996,1997,1998 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C
C Current version of TARCEL is restricted to cubic lattices
C
      IF(DX(1).NE.1..OR.DX(2).NE.1.)THEN
         CALL ERRMSG('FATAL','TARCEL',
     &               ' tarcel does not support noncubic lattice')
      ENDIF
C
C Inner ellipsoid is defined by
C      (X/AX)**2+(Y/AY)**2+(Z/AZ)**2 = 0.25
C Outer ellipsoid is defined by
C      (X/BX)**2+(Y/BY)**2+(Z/BZ)**2 = 0.25
C Material within inner ellipsoid is of composition 1
C Material between inner and outer ellipsoids is of composition 2
C
C Ideal volume V=(pi/6)*BX*BY*BZ
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 concentric spheres: call with AX=AY=AZ, BX=BY=BZ
C For spheroids: call with AX=AY (or AY=AZ or AX=AZ) and BX=BY (or BY=BZ
C   or BX=BZ)
C
C***********************************************************************
C
C Check that input parameters have "inner" ellipsoid smaller than
C "outer" ellipsoid:
      IF(AX.LT.BX)CALL ERRMSG('FATAL','TARCEL',' AX < BX ')
      IF(AY.LT.BY)CALL ERRMSG('FATAL','TARCEL',' AY < BY ')
      IF(AZ.LT.BZ)CALL ERRMSG('FATAL','TARCEL',' AZ < BZ ')
C Criterion for choosing XOFF: try to optimize outer ellipsoid surface
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+.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

      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
      BX2=BX*BX
      BY2=BY*BY
      BZ2=BZ*BZ

      NAT=0
      NIN=0

C Specify target axes A1 and A2
C   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
         RZ2=Z*Z/AZ2
         IF(RZ2.LT.0.25)THEN
            DO JY=LMY1,LMY2
               Y=REAL(JY)+YOFF
               RYZ2=RZ2+Y*Y/AY2
               IF(RYZ2.LT.0.25)THEN
                  DO 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
                        RR=Z*Z/BZ2+Y*Y/BY2+X*X/BX2
                        IF(RR.LT.0.25)THEN
C within inner ellipsoid:
                           ICOMP(NAT,1)=1
                           ICOMP(NAT,2)=1
                           ICOMP(NAT,3)=1
                           NIN=NIN+1
                        ELSE
C between inner and outer ellipsoids:
                           ICOMP(NAT,1)=2
                           ICOMP(NAT,2)=2
                           ICOMP(NAT,3)=2
                        ENDIF
                        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***********************************************************************
C Write target description into string CDESCR

      IF(AX.EQ.AY.AND.AX.EQ.AZ)THEN
         WRITE(CDESCR,FMT='(A,I7,A)')' Spherical target containing',
     &      NAT,' dipoles'
      ELSE
         WRITE(CDESCR,FMT='(A,I6,A,I7,A)')' Concentric ellipsoids with',
     &      NIN,' inner ',NAT,' total dipoles'
      ENDIF

C***********************************************************************

      IF(IOSHP.GE.0)THEN
         OPEN(UNIT=IOSHP,FILE='target.out',STATUS='UNKNOWN')
         WRITE(IOSHP,FMT=9020)AX,AY,AZ,BX,BY,BZ,NAT,NIN,
     &      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(' >TARCEL: concentric ellipsoids; AX,AY,AZ=',3F8.4,
     &       ' BX,BY,BZ=',3F8.4,/,
     &       I7,I7,' = NAT,NIN',/,
     &       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
