      SUBROUTINE TARHEX(A1,A2,A,B,CDESCR,IOSHP,MXNAT,NAT,IXYZ)
C Scalar arguments:
      CHARACTER CDESCR*67
      INTEGER IOSHP,MXNAT,NAT
      INTEGER*2 IXYZ(MXNAT,3)
      REAL A,B
C Array arguments:
      REAL A1(3),A2(3)
C Local scalars:
      CHARACTER CMSGNM*70
      INTEGER JA,JX,JY,JZ,NA,NB,NC,NFAC,NLAY,NMX,NMY,NMZ
      LOGICAL IN
      REAL ACM,ASPR,BCM,BEFF,CCM,X,Y,Z
C***********************************************************************
C Routine to construct hexagonal prism from "atoms"
C Input:
C        A=prism length/d
C        B=width of one hexagonal edge/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)=unit vector (1,0,0) defining target axis 1 (prism axis)
C        A2(1-3)=unit vector (0,1,0) defining target axis 2 (normal to
C                one of the rectangular faces.
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=string describing target (up to 67 chars.)
C
C B.T.Draine, Princeton Univ. Obs., 87.04.03
C
C History:
C 90.12.02 (BTD): IOSHP is now output device for target.out
C                 (and is now closed before returning)
C 90.12.14 (BTD): Rewritten so that atoms are always on integral sites
C                 but CM coords may be either integral or half-integral
C 91.01.05 (BTD): Change I4 -> I7 when printing NAT.
C 91.04.22 (BTD): Added XV,YV,ZV and A1,A2 to WRITE(IOSHP,FMT=9020)
C 92.09.09 (BTD+PJF): in output, NLAY was too large by factor 2 and NFAC
C                 too small by factor of 2: now fixed.
C 93.03.12 (BTD): Changed CDESCR*(*) -> CDESCR*67
C 95.07.13 (BTD): Simplify: restrict to case where prism axis is in
C                 x direction and y axis is normal to a rectangular
C                 face.
C 96.01.26 (BTD): Replaced IX,IY,IZ by IXYZ
C 96.02.23 (BTD): Delete PI (unused)
C 97.04.28 (BTD): Initialize NAT=0 (failure to do so reported by
C                 Michael Wolff).
C end history
C
C Copyright (C) 1993,1995,1996,1997 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
      DO 0100 JA=1,3
         A1(JA)=0.
         A2(JA)=0.
 0100 CONTINUE
      A1(1)=1.
      A2(2)=1.
C
C A = prism length
C B = prism "diameter"
C       B/2 = length of one side of hexagon
C       B= distance between opposite vertices=max.diameter of hexagon
C       for hexagon, area=(3/8)*SQRT(3)*B**2
C       for hex prism, volume=A*area=(3/8)*SQRT(3)*A*B**2
C Now determine limits for testing x,y,z values
C Along axis, run from 1 to NA=INT(A+0.5)
C Perp. to axis, run from 1 to NB=INT(B+0.5)
      NA=INT(A+0.5)
      NB=INT(B+0.5)
      NC=INT(.5*SQRT(3.)*B+0.5)
C ACM="center" of figure in axial direction
C BCM="center" of figure in B direction
C CCM="center" of figure in C direction
      ACM=REAL(NA)/2.+0.5
      BCM=REAL(NB)/2.+0.5
      CCM=REAL(NC)/2.+0.5
      NMX=NA
      NMY=NC
      NMZ=NB
      NAT=0
      DO 1200 JZ=1,NMZ
         Z=REAL(JZ)
         DO 1100 JY=1,NMY
            Y=REAL(JY)
            DO 1000 JX=1,NMX
               X=REAL(JX)
               CALL TESTHEX(ACM,BCM,CCM,A,B,X,Y,Z,IN)
               IF(IN)THEN
                  NAT=NAT+1
                  IXYZ(NAT,1)=JX
                  IXYZ(NAT,2)=JY
                  IXYZ(NAT,3)=JZ
               ENDIF
 1000       CONTINUE
 1100    CONTINUE
 1200 CONTINUE
C Now compute some geometric properties of pseudo-hexagonal prism
C   NLAY = number of layers = effective length of prism/d
C   NFAC = number of atoms in one hexagonal face
      NLAY=INT(A)
      NFAC=NAT/NLAY
C BEFF = effective length of hexagonal size/d
C        computed for hexagon of area NFAC*d**2
C                                     =(3/2)*SQRT(3)*BEFF**2
C Note: for hexagon, vertex-vertex diameter = 2*BEFF
      BEFF=.6204032*SQRT(FLOAT(NFAC))
C ASPR = effective aspect ratio of target = length/(2*BEFF)
      ASPR=.5*FLOAT(NLAY)/BEFF
C Note: string CDESCR will be printed by subr. TARGET
      WRITE(CDESCR,FMT='(A,I7,A)')' Hexagonal prism of NAT=',NAT,
     &                             ' dipoles'
C Here print any additional target info which is desired by using
C subroutine WRIMSG
      WRITE(CMSGNM,FMT='(A,3F7.4,A)')
     &    ' A1 = (',A1,') = hexagon symmetry axis'
      CALL WRIMSG('TARHEX',CMSGNM)
      WRITE(CMSGNM,FMT='(A,3F7.4,A)')
     &    ' A2 = (',A2,') = center-vertex axis'
      CALL WRIMSG('TARHEX',CMSGNM)
      WRITE(CMSGNM,FMT='(A,I7,A,I4,A,I4,A,F7.4)')
     &    ' NAT=',NAT,' NFAC=',NFAC,' NLAY=',NLAY,' aspect ratio=',ASPR
      CALL WRIMSG('TARHEX',CMSGNM)
      WRITE(CDESCR,FMT='(A,I7,A,I4,A,I4,A,F7.4)')
     &    ' Hex prism,NAT=',NAT,' NFAC=',NFAC,' NLAY=',NLAY,
     &    ' asp.ratio=',ASPR
C Now store atom coordinates in file
      IF(IOSHP.GT.0)THEN
          OPEN(UNIT=IOSHP,FILE='target.out',STATUS='UNKNOWN')
C*** 3 lines of general description allowed:
          WRITE(IOSHP,9020)A,B,NAT,A1,A2
C***
          DO 2000 JX=1,NAT
              WRITE(IOSHP,FMT=9030)JX,IXYZ(JX,1),IXYZ(JX,2),IXYZ(JX,3)
 2000     CONTINUE
          CLOSE(UNIT=IOSHP)
      ENDIF
      RETURN
 9020 FORMAT(' Hexagonal Prism:  A=',F7.4,' B=',F7.4,/,
     &I7,'= NAT. Prism axis along x, one rect. face. normal to y',/,
     &3F9.4,' = A_1 vector',/,
     &3F9.4,' = A_2 vector',/,
     &'     JA  IX  IY  IZ')
 9030 FORMAT(I7,3I4)
      END
      SUBROUTINE TESTHEX(ACM,BCM,CCM,A,B,X,Y,Z,IN)
C Arguments:
      REAL ACM,BCM,CCM,A,B,X,Y,Z
      LOGICAL IN
C Local variables:
      REAL AX,Q,U,V
C
C*** ACM,BCM,CCM=location of center in A,B,C directions
C    A direction is along axis
C    B direction is vertex to vertex of hexagon
C    C direction is face to face of hexagon
C
      AX=X
      U=Y-CCM
      V=Z-BCM
      IN=.FALSE.
C*** Test along axis:
      IF(2.*ABS(AX-ACM).GT.A)RETURN
C*** Test along C direction
C .4330127=SQRT(3)/4
      IF(ABS(U).GT.0.4330127*B)RETURN
C*** Now test whether closer to CM than line bounding edge
C .5773503=1/SQRT(3)
      Q=0.5*ABS(U)+0.8660254*ABS(V)
      IF(Q.GT.0.4330127*B)RETURN
      IN=.TRUE.
      RETURN
      END
