      SUBROUTINE TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
      IMPLICIT NONE
C
C Arguments:
C
      CHARACTER CDESCR*67,CFLSHP*80,CSHAPE*6
      INTEGER IDVOUT,IDVSHP,IOSHP,MXNAT,NAT,MXN3,NAT3,NPY,NPZ
      REAL A1(3),A2(3),DX(3),SHPAR(6)
      INTEGER*2 IXYZ(MXNAT,3),ICOMP(MXNAT,3)
      EXTERNAL ERRMSG,REASHP,TARCYL,TARELL,TARHEX,TARREC,TARTET
C
C Local variables:
C
      INTEGER BLKSIZ,IPRINAX,J,J1,NBLOCKS
      INTEGER XYZB(3,100)
C
C***********************************************************************
C Given:
C    CSHAPE = string describing target geometry; will determine which
C             "shape" routine is invoked.  Current options are:
C             RCTNGL, ELLIPS, CYLNDR, HEXGON, TETRAH, UNICYL, ANIELL,
C             TWOELL, TWOAEL, FRMFIL, THRELL, THRAEL, CONELL, BLOCKS,
C             DW1996, TWOSPH, LYRSLB, NSPHER, PRISM3, ANIREC
C    IOSHP = device number for "target.out" file
C          = -1 to suppress printing of "target.out"
C    SHPAR(1-6) = up to 6 parameters defining target geometry
C    DX(1-3)= d_x/d, d_y/d, d_z/d for lattice, where d=(d_x*d_y*d_z)**(1/3)
C             is the effective lattice spacing, and d_x,d_y,d_z are lattice
C             spacings in x,y,z directions
C    MXNAT = limit on largest allowed value of NAT
C    MXN3  = 3*MXNAT
C    IDVOUT = 1 to print out information on target shape
C            -1 to suppress printing information on target shape
C    CFLSHP = name of target shape file if CSHAPE='FRMFIL'
C    IDVSHP = device number to use to read target shape if
C             CSHAPE='FRMFIL'
C Returns:
C    A1,A2 = two 3-vectors defining initial target orientation
C    CDESCR = string describing target
C    NAT = number of dipoles in target
C    NAT3 = 3*NAT
C    IXYZ(1-NAT,1-3)=integers fixing x,y,z coordinates of
C         occupied sites in target
C    ICOMP(1-NAT,1-3)=composition for E in x,y,z direction at each site
C    NPY = 0 if isolated target
C        = (periodicity in target frame y direction)/DX(2) if periodic
C           boundary conditions are to be used
C    NPZ = 0 if isolated target
C        = (periodicity in target frame z direction)/DX(3) if periodic
C           boundary conditions are to be used
C
C P.J.Flatau, Colorado State University
C B.T.Draine, Princeton Univ. Observatory
C History:
C 90.11.08 (BTD): Changed DO...ENDDO to DO #...# CONTINUE
C 90.12.02 (BTD): Changed ordering of data in ICOMP
C 90.12.14 (BTD): Changed option MKRECT -> RCTNGL
C 91.05.02 (BTD): Added IDVOUT to argument list
C                 Added IDVOUT to argument list for subr. REASHP
C 91.05.23 (BTD): Added A1,A2 to arg. list for subr. REASHP
C 91.11.12 (BTD): Added IDVSHP to arg. list for TARGET and REASHP
C 92.09.21 (BTD): Added option UNIELL (uniaxial ellipsoid)
C 93.01.07 (BTD): Added option TWOELL (two touching ellipsoids,
C                 consisting of materials 1 and 2)
C 92.01.07 (BTD): Added option TWOAEL (two touching anisotropic
C                 ellipsoids, 1st with diel.fnc.1,2,3 along x,y,z
C                 2nd with diel.fnc.4,5,6 along x,y,z
C 92.01.19 (BTD): Added option THRELL (three touching anisotropic
C                 ellipsoids, 1st with diel.fnc.1,2,3 along x,y,z
C                 2nd with diel.fnc.4,5,6 along x,y,z
C                 3rd with diel.fnc.7,8,9 along x,y,z
C 93.03.12 (BTD): Changed CDESCR*60 -> CDESCR*67
C                 Moved WRITE(IDVOUT,9010) from DDSCAT to TARGET
C 93.12.14 (BTD): Corrected handling of THRELL (had assigned
C                 ICOMP=1 to 50% of sites, ICOMP=2 to other 50%)
C 94.01.27 (BTD): Replaced SHPAR1,SHPAR2,SHPAR3 by SHPAR(1-6) to
C                 allow up to 6 shape parameters
C                 Added call to TARCEL to generate two concentric
C                 ellipsoids
C 94.03.21 (BTD): Changed "CONCEL" to "CONELL" for consistency with
C                 REAPAR
C 95.12.11 (BTD): Modified to handle "BLOCKS" as target option, using
C                 subroutine TARBLOCKS
C 96.01.04 (BTD): Modified to handle "DW1996" as target option
C 96.01.25 (BTD): Modified to handle "TWOSPH" as target option
C 96.01.26 (BTD): Replaced IX,IY,IZ by IXYZ
C 96.01.29 (BTD): Added variable IPRINAX to control choice of axes A1,A2
C                 in option BLOCKS
C 97.06.04 (BTD): Corrected bug in handling of option "UNICYL" -- was
C                 not setting composition correctly after changing REAPAR
C                 so that no longer had choice of cylinder axis.
C                 Cylinder axis is always in x direction in target frame.
C                 Thanks for Mike Wolff for calling attention to the
C                 bug.
C 97.11.01 (BTD): add DX to argument list to allow use of noncubic lattice
C                 add DX to argument list of TARELL
C 97.12.26 (BTD): add DX to argument list of TARREC, TARCYL, TARHEX,
C                 TARTET, TAR2EL, TAR3EL, TARCEL, TAR2SP 
C 98.04.27 (BTD): restored missing comma in argument list of TAR2EL
C 98.12.29 (BTD): added new option 'LYRSLB' for layered slab
C 00.06.12 (BTD): modified to support option TARNSP for multisphere
C                 target, including variable lattice spacing DX
C                 all data type conversions now explicit
C 00.07.18 (BTD): corrected bug in calls to tarblocks
C 00.11.02 (BTD): added ICOMP to arg. list for TAR2EL,TAR3EL,TARCYL,
C                 TARELL,TARHEX,TARREC,RCTNGL,TARTET
C 02.02.12 (BTD): added option PRISM3 and call to routine TARPRSM
C 03.05.21 (BTD): added option SPHARM = irregular target
C                 generated using spherical harmonics
C                 target generated by TARSPHARM
C 03.05.22 (BTD): bug fix: define CFLSHP='spharm.par' when calling
C                 TARSPHARM
C 03.11.06 (BTD): modify to use new version of TARSPHARM
C 04.03.19 (BTD): change CFLSHP*13 to CFLSHP*80 to accomodate long file
C                 names
C 04.04.01 (BTD): added arguments NPY,NPZ to support periodic b.c.
C                 option (at present time, used only for target option
c                 NSPPBC)
c 04.04.01 (BTD): Add DX to argument list of TARGSPHER
c                 Remove call to TARSPHARM -- this is superseded by
c                 TARGSPHER
c 04.04.29 (BTD): Add option ANIREC for anisotropic rectangular target
c 06.09.13 (BTD): Add new target option CYLCAP
C end history
C
C Copyright (C) 1993,1994,1995,1996,1997,1998,2000,2002,2003,2004,2006
C               B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
c Most targets are isolated, so set NPY=NPZ=0 as the default, to be
c changed only in case of targets with periodic b.c.

      NPY=0
      NPZ=0

C-----------------------------------------------------------------------
C RCTNGL -> homogeneous, isotropic, rectangular target

      IF(CSHAPE.EQ.'RCTNGL')THEN
         CALL TARREC(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C ANIREC -> homogeneous, anisotropic, rectangular target

      ELSEIF(CSHAPE.EQ.'ANIREC')THEN
         CALL TARANIREC(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,
     &                  IOSHP,MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C ELLIPS -> homogeneous, isotropic, ellipsoidal target

      ELSEIF(CSHAPE.EQ.'ELLIPS')THEN
         CALL TARELL(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C CYLNDR -> homogeneous, isotropic cylinder

      ELSEIF(CSHAPE.EQ.'CYLNDR')THEN
         CALL TARCYL(A1,A2,SHPAR(1),SHPAR(2),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C CYLCAP -> homogeneous, isotropic cylinder with hemispherical caps

      ELSEIF(CSHAPE.EQ.'CYLCAP')THEN
         CALL TARCYLCAP(A1,A2,SHPAR(1),SHPAR(2),DX,CDESCR,IOSHP,
     &                  MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C HEXGON -> homogeneous, isotropic hexagonal prism

      ELSEIF(CSHAPE.EQ.'HEXGON')THEN
         CALL TARHEX(A1,A2,SHPAR(1),SHPAR(2),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C TETRAH -> homogeneous, isotropic tetrahedron

      ELSEIF(CSHAPE.EQ.'TETRAH')THEN
         CALL TARTET(A1,A2,SHPAR(1),DX,CDESCR,IOSHP,MXNAT,NAT,IXYZ,
     &               ICOMP)

C-----------------------------------------------------------------------
C UNICYL -> uniaxial cylinder
C Cylinder axis is in x direction in Target Frame.
C Assume c axis to be parallel to cylinder axis
C Assume component 1 to be dielectric const. for E par. c axis
C Assume component 2 to be dielectric const. for E perp. c axis

      ELSEIF(CSHAPE.EQ.'UNICYL')THEN
         CALL TARCYL(A1,A2,SHPAR(1),SHPAR(2),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C Set composition

         DO J=1,NAT
            ICOMP(J,1)=1
            ICOMP(J,2)=2
            ICOMP(J,3)=2
         ENDDO

C-----------------------------------------------------------------------
C ANIELL -> anisotropic ellipsoid

      ELSEIF(CSHAPE.EQ.'ANIELL')THEN
         CALL TARELL(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C Dielectric constants 1,2,3 for E along directions x,y,z in Target Frame

         DO J=1,NAT
            ICOMP(J,1)=1
            ICOMP(J,2)=2
            ICOMP(J,3)=3
         ENDDO

C-----------------------------------------------------------------------
C TWOELL -> two touching identical ellipsoids, of materials 1 and 2
C           second ellipsoid is displaced from first in x-direction

      ELSEIF(CSHAPE.EQ.'TWOELL')THEN
         CALL TAR2EL(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C TWOAEL -> two touching identical ellipsoids with anisotropic
C           functions.
C           second ellipsoid is displaced from first in x-direction
C           1st ellipsoid has dielectric fcns 1,2,3 in x,y,z dirs.
C           2nd ellipsoid has dielectric fcns 4,5,6 in x,y,z dirs.

      ELSEIF(CSHAPE.EQ.'TWOAEL')THEN
         CALL TAR2EL(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)
         J1=NAT/2
         DO J=1,J1
            ICOMP(J,1)=1
            ICOMP(J,2)=2
            ICOMP(J,3)=3
         ENDDO
         DO J=J1+1,NAT
            ICOMP(J,1)=4
            ICOMP(J,2)=5
            ICOMP(J,3)=6
         ENDDO

C-----------------------------------------------------------------------
C THRELL -> three touching identical ellipsoids, of materials 1,2,3
C           second ellipsoid is displaced from first in +x-direction
C           third ellipsoid is displaced from second in +x-direction
C           1st,2nd,3rd ellipsoid has ICOMP=1,2,3 (set in TAR3EL)

      ELSEIF(CSHAPE.EQ.'THRELL')THEN
         CALL TAR3EL(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C THRAEL -> three touching identical ellipsoids with anisotropic
C           functions.  Need to override TAR3EL.
C           second ellipsoid is displaced from first in x-direction
C           1st ellipsoid has dielectric fcns 1,2,3 in x,y,z dirs.
C           2nd ellipsoid has dielectric fcns 4,5,6 in x,y,z dirs.
C           3rd ellipsoid has dielectric fcns 7,8.9 in x,y,z dirs.

      ELSEIF(CSHAPE.EQ.'THRAEL')THEN
         CALL TAR3EL(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),DX,CDESCR,IOSHP,
     &               MXNAT,NAT,IXYZ,ICOMP)
         J1=NAT/3
         DO J=1,J1
            ICOMP(J,1)=1
            ICOMP(J,2)=2
            ICOMP(J,3)=3
         ENDDO
         DO J=J1+1,2*J1
            ICOMP(J,1)=4
            ICOMP(J,2)=5
            ICOMP(J,3)=6
         ENDDO
         DO J=2*J1+1,NAT
            ICOMP(J,1)=7
            ICOMP(J,2)=8
            ICOMP(J,3)=9
         ENDDO

C-----------------------------------------------------------------------
C CONELL -> two concentric ellipsoids with isotropic dielectric functions
C           1 (inner) and 2 (outer)

      ELSEIF(CSHAPE.EQ.'CONELL')THEN
         CALL TARCEL(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),SHPAR(4),SHPAR(5),
     &               SHPAR(6),DX,CDESCR,IOSHP,MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C TAR2SP -> two touching spheroids

      ELSEIF(CSHAPE.EQ.'TWOSPH')THEN
         CALL TAR2SP(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),SHPAR(4),SHPAR(5),
     &               SHPAR(6),DX,CDESCR,IOSHP,MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C BLOCKS -> target is constructed from identical cubic blocks
C           locations of blocks, and size of blocks (lattice units)
C           is specified in file 'blocks.par'
C           file structure:
C              target description
C              IPRINAX = 0 (a1=100,a2=010) or 1 (a1,a2=principal axes)
C              N = number of blocks
C              SIZE = width of one block, in lattice units
C              X Y Z = location of block 1 (in units of block width)
C              ...
C              X Y Z =    "     "    "   N  "   "    "    "     "
C
      ELSEIF(CSHAPE.EQ.'BLOCKS')THEN
         OPEN(UNIT=IDVSHP,FILE='blocks.par',STATUS='OLD',
     &        FORM='FORMATTED')
         READ(IDVSHP,FMT='(A67)')CDESCR
         READ(IDVSHP,*)IPRINAX
         READ(IDVSHP,*)NBLOCKS
         READ(IDVSHP,*)BLKSIZ
         DO J=1,NBLOCKS
            READ(IDVSHP,*)XYZB(1,J),XYZB(2,J),XYZB(3,J)
         ENDDO
         CLOSE(IDVSHP)
         CALL TARBLOCKS(A1,A2,DX,NBLOCKS,BLKSIZ,XYZB,IPRINAX,IOSHP,
     &                  CDESCR,MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C DW1996 -> the 13-cube target studied by Draine & Weingartner 1996
C           SHPAR(1)=width per block in lattice units

      ELSEIF(CSHAPE.EQ.'DW1996')THEN
         IPRINAX=1
         NBLOCKS=13
         BLKSIZ=NINT(SHPAR(1))
         XYZB(1,1)=0
         XYZB(2,1)=1
         XYZB(3,1)=0
         XYZB(1,2)=1
         XYZB(2,2)=1
         XYZB(3,2)=0
         XYZB(1,3)=0
         XYZB(2,3)=2
         XYZB(3,3)=0
         XYZB(1,4)=1
         XYZB(2,4)=2
         XYZB(3,4)=0
         XYZB(1,5)=0
         XYZB(2,5)=1
         XYZB(3,5)=1
         XYZB(1,6)=1
         XYZB(2,6)=1
         XYZB(3,6)=1
         XYZB(1,7)=0
         XYZB(2,7)=2
         XYZB(3,7)=1
         XYZB(1,8)=1
         XYZB(2,8)=2
         XYZB(3,8)=1
         XYZB(1,9)=2
         XYZB(2,9)=1
         XYZB(3,9)=0
         XYZB(1,10)=2
         XYZB(2,10)=2
         XYZB(3,10)=0
         XYZB(1,11)=0
         XYZB(2,11)=0
         XYZB(3,11)=1
         XYZB(1,12)=0
         XYZB(2,12)=0
         XYZB(3,12)=2
         XYZB(1,13)=0
         XYZB(2,13)=1
         XYZB(3,13)=2
         CALL TARBLOCKS(A1,A2,DX,NBLOCKS,BLKSIZ,XYZB,IPRINAX,IOSHP,
     &                  CDESCR,MXNAT,NAT,IXYZ,ICOMP)
         CDESCR='13-cube target used by Draine & Weingartner 1996'

C-----------------------------------------------------------------------
C TARSLB -> Layered slab:

      ELSEIF(CSHAPE.EQ.'LYRSLB')THEN
         CALL TARSLB(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),SHPAR(4),SHPAR(5),
     &               SHPAR(6),DX,CDESCR,IOSHP,MXNAT,NAT,IXYZ,ICOMP)
C
C slab has dimensions a,b,c in x,y,z dimensions
C current version allows for up to 4 layers
C slab is layered in x direction
C  0 < x < x1 is composition 1
C x1 < x < x2 is composition 2
C x2 < x < x3 is composition 3
C x3 < x < a  is composition 4

C for fewer than 4 layers, let x2 or x3=0

C SHPAR(1-3)= a/d , b/d , c/d  where d=(dx*dy*dz)**{1/3}
C SHPAR(4)  = x1/a
C SHPAR(5)  = x2/a
C SHPAR(6)  = x3/a

C-----------------------------------------------------------------------
C NSPHER -> Multisphere target:

      ELSEIF(CSHAPE.EQ.'NSPHER')THEN

         CALL TARNSP(A1,A2,SHPAR(1),SHPAR(2),DX,CFLSHP,CDESCR,
     &               IDVSHP,IOSHP,MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C PRISM3 -> triangular prism:

      ELSEIF(CSHAPE.EQ.'PRISM3')THEN
         CALL TARPRSM(A1,A2,SHPAR(1),SHPAR(2),SHPAR(3),SHPAR(4),DX,
     &                CDESCR,IOSHP,MXNAT,NAT,IXYZ,ICOMP)

c-----------------------------------------------------------------------
c GSPHER -> gaussian sphere target
C SHPAR(1)= a_eff/d
C SHPAR(2)= 0. to use A1=(1,0,0),A2=(0,1,0) in TF
C           1. to use A1,A2 = principal axes with largest,2nd largest
C              moment of inertia
C SHPAR(3)= BETA : for L>1, contribution of different L values to
C                  <s^2> varies as L^{-BETA}
C SHPAR(4)= LMAX : maximum value of L to use
C SHPAR(5)= <s^2>
C SHPAR(6)= RSEED

      ELSEIF(CSHAPE.EQ.'GSPHER')THEN
c*** diagnostic
         write(0,*)'about to call targspher with shpar(1)=',shpar(1)
c***
         CALL TARGSPHER(SHPAR(1),SHPAR(2),SHPAR(3),SHPAR(4),SHPAR(5),
     &                  SHPAR(6),A1,A2,DX,CFLSHP,
     &                  CDESCR,IOSHP,MXNAT,NAT,IXYZ,ICOMP)

C-----------------------------------------------------------------------
C NSPPBC -> cluster of N spheres with periodic boundary conditions
C           with A1=(1,0,0), A2=(0,1,0) in target frame
C SHPAR(1) = DIAMX=max extent in target frame x direction/d
C SHPAR(2) = NPY = (periodicity in target y direction)/DX(2)
C SHPAR(3) = NPZ = (periodicity in target z direction)/DX(3)

      ELSEIF(CSHAPE.EQ.'NSPPBC')THEN
         CALL TARNSP(A1,A2,SHPAR(1),0.,DX,CFLSHP,CDESCR,
     &               IDVSHP,IOSHP,MXNAT,NAT,IXYZ,ICOMP)
         NPY=NINT(SHPAR(2))
         NPZ=NINT(SHPAR(3))

C-----------------------------------------------------------------------
C add any other specific shape routines here

C-----------------------------------------------------------------------
C FRMFIL -> read list of occupied sites and compositions from file

      ELSEIF(CSHAPE.EQ.'FRMFIL')THEN
         CALL REASHP(CFLSHP,IDVOUT,IDVSHP,A1,A2,DX,CDESCR,MXNAT,NAT,
     &                IXYZ,ICOMP,MXN3,NAT3)

C-----------------------------------------------------------------------
C Reach here only in event of error:

      ELSE
         CALL ERRMSG('FATAL','TARGET',
     &               ' Uknown shape requested: check ddscat.par')
      ENDIF

C Check to see that arrays are large enough

      IF(NAT.GT.MXNAT)CALL ERRMSG('FATAL','TARGET',
     &                ' MXNAT < NAT; must increase MXNAT in DDSCAT')

C Write out target description

      WRITE(IDVOUT,FMT=9010)CDESCR,NAT

C Before returning, compute:

      NAT3=3*NAT
      RETURN
 9010 FORMAT(' >TARGET:',A,/,
     &       7X,I7,' = NAT0 = number of dipoles in target')
      END




