      SUBROUTINE TARCYL(A1,A2,A,B,CDESCR,IOSHP,MXNAT,NAT,IXYZ)
C***********************************************************************
C Purpose: to construct cylindrical target from "atoms", with cylinder
C axis along x axis.
C Input:
C        A = cylinder length (in units of lattice spacing d)
C        B = cylinder diameter (in units of lattice spacing d)
C        IOSHP=device number for "target.out" file
C             =-1 to suppress printing of "target.out"
C        MXNAT = dimensioning information
C Returns:
C        A1(1-3) = unit vector along cylinder axis
C        A2(1-3) = unit vector perpendicular to cylinder axis
C        CDESCR = string describing target (up to 67 chars.)
C        NAT = number of atoms in target
C        IXYZ(1-NAT,1-3)=x/d,y/d,z/d for atoms in target
C
C B.T.Draine, Princeton Univ. Obs., 87.04.03
C History:
C 89.12.21 (BTD): Modified for use by ddscat 89.12.21
C 90.12.03 (BTD): Modified for conformity with other target routines
C 91.01.05 (BTD): Changed I4 -> I7 when printing NAT
C 91.04.22 (BTD): Added XV,YV,ZV and A1,A2 to WRITE(IOSHP,FMT=9020)
C 93.03.12 (BTD): Changed CDESCR*(*) -> CDESCR*67
C 95.04.07 (BTD): Corrected error in code which affected target
C                 construction for 4.5<B<5.5, 6.5<B<7.5, ...
C                 In these cases code was construction target with
C                 diameter 4, 6, ... dipoles
C                 This error was discovered by Tao Du
C 96.01.25 (BTD): Modified for conformity with DDSCAT.5a
C 96.01.26 (BTD): Replaced IX,IY,IZ by IXYZ
C end history
C Copyright (C) 1993,1995,1996 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C Scalar arguments:
      CHARACTER CDESCR*67
      INTEGER MXNAT,NAT
      REAL A,B
C Array arguments:
      INTEGER*2 IXYZ(MXNAT,3)
      REAL A1(3),A2(3)
C Local scalars:
      INTEGER IAXIS,IOSHP,JX,JY,JZ,
     &    NB,NBD,NBMAX,NBMIN,NFAC,NLAY,
     &    NX1,NX2,NY1,NY2,NZ1,NZ2
      LOGICAL IN
      REAL ASPR,PI,REFF2,ROFF,X,XOFF,Y,YOFF,Z,ZOFF
C
      PI=4.*ATAN(1.)
C
C Earlier version allowed choice of axis direction.
C Here we require cylinder axis to be x axis
C
      IAXIS=1
C
C Determine limits for testing x,y,z values
C In case of disk axis, run from I=1 to I=INT(A+0.5)
C In radial directions, place atoms as follows:
C     If B is close to even number
C          x = i + 0.5
C          with i running from -int((b+.5)/2) to int((b+.5)/2)-1
C     If B is close to odd number
C          x = i
C          with i running from -int((b+.5)/2) to int((b+.5)/2)
C
      NBD=INT(B+0.5)
      NB=INT(NBD/2)
      IF(NBD.EQ.2*(NBD/2))THEN
         ROFF=0.5
         NBMIN=-NB
         NBMAX=NB-1
      ELSE
         ROFF=0.
         NBMIN=-NB
         NBMAX=NB
      ENDIF
C
      DO 0100 JX=1,3
         A1(JX)=0.
         A2(JX)=0.
 0100 CONTINUE
         NX1=NBMIN
         NX2=NBMAX
         NY1=NBMIN
         NY2=NBMAX
         NZ1=NBMIN
         NZ2=NBMAX
         XOFF=ROFF
         YOFF=ROFF
         ZOFF=ROFF
      IF(IAXIS.EQ.1)THEN
         A1(1)=1.
         A2(2)=1.
         XOFF=0.
         NX1=1
         NX2=INT(A+0.5)
      ELSEIF(IAXIS.EQ.2)THEN
         A1(2)=1.
         A2(3)=1.
         YOFF=0.
         NY1=1
         NY2=INT(A+0.5)
      ELSEIF(IAXIS.EQ.3)THEN
         A1(3)=1.
         A2(1)=1.
         ZOFF=0.
         NZ1=1
         NZ2=INT(A+0.5)
      ENDIF
      NAT=0
      DO 1200 JZ=NZ1,NZ2
         Z=REAL(JZ)+ZOFF
         DO 1100 JY=NY1,NY2
            Y=REAL(JY)+YOFF
            DO 1000 JX=NX1,NX2
               X=REAL(JX)+XOFF
               CALL TESTCYL(X,Y,Z,A,B,IAXIS,IN)
               IF(IN)THEN
                  NAT=NAT+1
                  IF(NAT.GT.MXNAT)THEN
                      CALL ERRMSG('FATAL','TARCYL',' NAT.GT.MXNAT')
                  ENDIF
                  IXYZ(NAT,1)=JX
                  IXYZ(NAT,2)=JY
                  IXYZ(NAT,3)=JZ
               ENDIF
 1000       CONTINUE
 1100   CONTINUE
 1200 CONTINUE
C
C NLAY = number of layers in cylinder
C NFAC = number of atoms in slice
      NLAY=INT(A+0.5)
      NFAC=NAT/NLAY
C REFF2=EFFECTIVE RADIUS**2 OF DISK
      REFF2=REAL(NFAC)/PI
C ASPR=ASPECT RATIO (LENGTH/DIAMETER)
      ASPR=0.5*REAL(NLAY)/SQRT(REFF2)
      WRITE(CDESCR,FMT='(A,I7,A,I4,A,I4,A,F7.4)')
     &    ' Cyl.prism, NAT=',NAT,' NFAC=',NFAC,' NLAY=',NLAY,
     &    ' asp.ratio=',ASPR
C
      IF(IOSHP.GE.0)THEN
         OPEN(UNIT=IOSHP,FILE='target.out',STATUS='UNKNOWN')
         WRITE(IOSHP,FMT=9020)A,B,IAXIS,NAT,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
 6100 FORMAT(' IAXIS=',I2,/,' A=',F7.3,/,' B=',F7.3,/,' NAT=',I4)
 9020 FORMAT(' >TARELL  cylindrical target: Length=',F8.4,
     &' Diameter=',F8.4,' IAXIS=',I1,/,
     &I7,' = NAT',/,
     &3F9.4,' = A_1 vector',/,
     &3F9.4,' = A_2 vector',/,
     &'     JA  IX  IY  IZ')
 9030 FORMAT(I7,3I4)
      END
      SUBROUTINE TESTCYL(X,Y,Z,A,B,IAXIS,IN)
C Scalar arguments:
      INTEGER IAXIS
      LOGICAL IN
      REAL A,B,X,Y,Z
C Local scalars:
      REAL R2,S
      IN=.FALSE.
      IF(IAXIS.EQ.1)THEN
         S=X
         R2=Y*Y+Z*Z
      ELSEIF(IAXIS.EQ.2)THEN
         S=Y
         R2=X*X+Z*Z
      ELSEIF(IAXIS.EQ.3)THEN
         S=Z
         R2=X*X+Y*Y
      ENDIF
      IF(R2.GT.0.25*B*B)RETURN
      IF(S.LT.1.)RETURN
      IF(S.GT.INT(A+.5))RETURN
      IN=.TRUE.
      RETURN
      END

