      PROGRAM CALLTARGET
C
C Program CALLTARGET is used to generate target arrays using target
C generation routines employed by DDSCAT.
C
C B.T.Draine, Princeton Univ. Obs., 91/1/1
C History:
C 91.05.24 (BTD): Modified to allow entry target names in lower case
C 91.07.16 (BTD): Replaced DO...ENDDO with DO #...# CONTINUE
C 92.12.16 (BTD): Added IDVSHP to argument list of TARGET
C 93.01.07 (BTD): Added options TWOELL and TWOAEL
C 94.05.15 (BTD): Added option CONELL
C 95.12.11 (BTD): Added option BLOCKS
C 96.01.04 (BTD): Added option DW1996
C 96.01.25 (BTD): Added option TWOSPH
C 96.01.26 (BTD): Replaced IX,IY,IZ by IXYZ here and in TARGET
C                 Added calls to SIZER
C 96.01.29 (BTD): Support selection of principal axis calculation
C                 in TAR2SP via SHPAR(6)
C 97.04.25 (BTD): Added option BLK_AN
C 97.04.30 (BTD): Removed code offering choice on target axis for
C                 HEXGON option (target axis now hardwired within
C                 TARHEX)
C end history
C
C Copyright (C) 1993,1994,1995,1996,1997 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C
C Adjustable parameters:
C    MXNAT=max.number of dipoles in target
      INTEGER MXNAT
      PARAMETER(MXNAT=200000)
C Derived parameters:
      INTEGER MXN3
      PARAMETER(MXN3=3*MXNAT)
C Variables:
      CHARACTER CDESCR*67,CFLSHP*13,CSHAPE*6
      INTEGER IDVSHP,IDVOUT,IOSHP,J,JJ,NAT,NAT3
      INTEGER LXYZ(3)
      INTEGER*2 IXYZ(MXNAT,3),ICOMP(MXNAT,3)
      REAL ERR,F,PI,RGYR2,RXY,RXZ,RYX,RYZ,RZX,RZY,
     &     X,XCM,Y,YCM,Z,ZCM
      REAL A1(3),A2(3),SHPAR(6)
      DOUBLE PRECISION DX,DY,DZ,X2,Y2,Z2
C
C***********************************************************************
      DATA IDVOUT/0/,IOSHP/15/
      PI=4.*ATAN(1.)
C Define variables CFLSHP and IDVSHP to please flint:
      CFLSHP='none'
      IDVSHP=999
 1000 WRITE(IDVOUT,*)'What shape? (Enter choice in quotes) Choices:'
      WRITE(IDVOUT,*)'  BLK_AN = construct from anisotropic cubic ',
     &               'blocks, input from "blocks.par"'
      WRITE(IDVOUT,*)'  BLOCKS = construct from cubic blocks, input ',
     &               'from file "blocks.par"'
      WRITE(IDVOUT,*)'  CONELL = two concentric ellipsoids'
      WRITE(IDVOUT,*)'  CYLNDR = cylinder'
      WRITE(IDVOUT,*)'  DW1996 = 13 cube target used by Draine & ',
     &               'Weingartner (1996)'
      WRITE(IDVOUT,*)'  ELLIPS = ellipsoid'
      WRITE(IDVOUT,*)'  HEXGON = hexagonal prism'
      WRITE(IDVOUT,*)'  RCTNGL = rectangular solid'
      WRITE(IDVOUT,*)'  SPHERE = sphere'
      WRITE(IDVOUT,*)'  TETRAH = regular tetrahedron'
      WRITE(IDVOUT,*)'  THRAEL = three collinear touching anisotropic ',
     &               'ellipsoids'
      WRITE(IDVOUT,*)'  THRELL = three collinear touching ellipsoids'
      WRITE(IDVOUT,*)'  TWOAEL = two touching anisotropic ellipsoids'
      WRITE(IDVOUT,*)'  TWOELL = two touching isotropic ellipsoids'
      WRITE(IDVOUT,*)'  TWOSPH = two touching spheroids (with angle ',
     &               'phi between symm. axes'
      READ(*,*)CSHAPE
      IF(CSHAPE.EQ.'TETRAH'.OR.CSHAPE.EQ.'tetrah')THEN
         CSHAPE='TETRAH'
         DO 1100 J=1,100
            WRITE(IDVOUT,*)'Enter tetrahedron side length ',
     &                     ' (0 to stop)'
            READ(*,*)SHPAR(1)
            SHPAR(2)=SHPAR(1)
            SHPAR(3)=SHPAR(1)
            IF(SHPAR(1).LE.0.)STOP
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(*,6000)SHPAR(1),NAT
 1100    CONTINUE
         STOP
      ELSEIF(CSHAPE.EQ.'SPHERE'.OR.CSHAPE.EQ.'sphere')THEN
         CSHAPE='SPHERE'
         DO 1200 J=1,100
            WRITE(IDVOUT,*)'Enter sphere diameter (0 to stop)'
            READ(*,*)SHPAR(1)
            IF(SHPAR(1).LE.0.)stop
            SHPAR(2)=SHPAR(1)
            SHPAR(3)=SHPAR(1)
            CSHAPE='ELLIPS'
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            RGYR2=0.
            XCM=0.
            YCM=0.
            ZCM=0.
            DO 1150 JJ=1,NAT
               X=IXYZ(JJ,1)
               Y=IXYZ(JJ,2)
               Z=IXYZ(JJ,3)
               XCM=XCM+X
               YCM=YCM+Y
               ZCM=ZCM+Z
               RGYR2=RGYR2+X*X+Y*Y+Z*Z+0.25
 1150       CONTINUE
            XCM=XCM/REAL(NAT)
            YCM=YCM/REAL(NAT)
            ZCM=ZCM/REAL(NAT)
            RGYR2=RGYR2/REAL(NAT)-XCM**2-YCM**2-ZCM**2
            F=(5./3.)*(4.*PI/REAL(3.*NAT))**(2./3.)*RGYR2
            WRITE(*,6100)SHPAR(1),SHPAR(2),SHPAR(3),NAT,F
 1200       CONTINUE
         STOP
      ELSEIF(CSHAPE.EQ.'ELLIPS'.OR.CSHAPE.EQ.'ellips')THEN
         CSHAPE='ELLIPS'
         DO 1300 J=1,100
            WRITE(IDVOUT,*)'Enter ellipsoid diameters xv,yv,zv',
     &                     ' (0,0,0 to stop)'
            READ(*,*)SHPAR(1),SHPAR(2),SHPAR(3)
            IF(SHPAR(1).LE.0.)stop
            CSHAPE='ELLIPS'
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            XCM=0.
            YCM=0.
            ZCM=0.
            DO 1250 JJ=1,NAT
               X=IXYZ(JJ,1)
               Y=IXYZ(JJ,2)
               Z=IXYZ(JJ,3)
               XCM=XCM+X
               YCM=YCM+Y
               ZCM=ZCM+Z
 1250       CONTINUE
            XCM=XCM/REAL(NAT)
            YCM=YCM/REAL(NAT)
            ZCM=ZCM/REAL(NAT)
            X2=0.
            Y2=0.
            Z2=0.
            DO 1260 JJ=1,NAT
               DX=IXYZ(JJ,1)-XCM
               DY=IXYZ(JJ,2)-YCM
               DZ=IXYZ(JJ,3)-ZCM
               X2=X2+DX*DX
               Y2=Y2+DY*DY
               Z2=Z2+DZ*DZ
 1260       ENDDO
            X2=X2/NAT+1./12.
            Y2=Y2/NAT+1./12.
            Z2=Z2/NAT+1./12.
            ERR=20.*PI*SQRT(5.*X2*Y2*Z2)/(3.*NAT)-1.
            RXY=SQRT(X2/Y2)
            RYZ=SQRT(Y2/Z2)
            RZX=SQRT(Z2/X2)
            RYX=1./RXY
            RZY=1./RYZ
            RXZ=1./RZX
            X2=2.*SQRT(5.*X2)
            Y2=2.*SQRT(5.*Y2)
            Z2=2.*SQRT(5.*Z2)
            WRITE(*,6200)SHPAR(1),SHPAR(2),SHPAR(3),NAT,X2,Y2,Z2,ERR,
     &                   RYX,RZX,RYZ,RXY,RXZ,RZY
 1300    CONTINUE
         STOP
      ELSEIF(CSHAPE.EQ.'CYLNDR'.OR.CSHAPE.EQ.'cylndr')THEN
         CSHAPE='CYLNDR'
         DO 1400 J=1,100
            WRITE(IDVOUT,*)'Enter cylinder length (0 to stop)'
            READ(*,*)SHPAR(1)
            IF(SHPAR(1).LE.0.)STOP
            WRITE(IDVOUT,*)'Enter cylinder diameter'
            READ(*,*)SHPAR(2)
            WRITE(IDVOUT,*)'Enter 1,2,3 for axis along x,y,z'
            READ(*,*)SHPAR(3)
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
 1400    CONTINUE
         STOP
      ELSEIF(CSHAPE.EQ.'RCTNGL'.OR.CSHAPE.EQ.'rctngl')THEN
         CSHAPE='RCTNGL'
         DO 1500 J=1,100
            WRITE(IDVOUT,*)'Enter x-length (0 to stop)'
            READ(*,*)SHPAR(1)
            IF(SHPAR(1).LE.0.)STOP
            WRITE(IDVOUT,*)'Enter y-length'
            READ(*,*)SHPAR(2)
            WRITE(IDVOUT,*)'Enter z-length'
            READ(*,*)SHPAR(3)
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
 1500    CONTINUE
      ELSEIF(CSHAPE.EQ.'HEXGON'.OR.CSHAPE.EQ.'hexgon')THEN
         CSHAPE='HEXGON'
         DO 1600 J=1,100
            WRITE(IDVOUT,*)'Enter length (along symmetry axis)',
     &                     ' (0 to stop)'
            READ(*,*)SHPAR(1)
            IF(SHPAR(1).LE.0.)STOP
            WRITE(IDVOUT,*)'Enter hexagon diameter = 2*side width'
            READ(*,*)SHPAR(2)
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
 1600    CONTINUE
      ELSEIF(CSHAPE.EQ.'TWOELL'.OR.CSHAPE.EQ.'twoell')THEN
         CSHAPE='TWOELL'
         DO 1700 J=1,100
            WRITE(IDVOUT,*)'Enter length of one ellipsoid in x, y, z',
     &                     ' directions (0 0 0 to stop)'
            READ(*,*)SHPAR(1),SHPAR(2),SHPAR(3)
            IF(SHPAR(1).LE.0)STOP
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
 1700    CONTINUE
      ELSEIF(CSHAPE.EQ.'TWOAEL'.OR.CSHAPE.EQ.'twoael')THEN
         CSHAPE='TWOAEL'
         DO 1800 J=1,100
            WRITE(IDVOUT,*)'Enter length of one ellipsoid in x, y, z',
     &                     ' directions (0 0 0 to stop)'
            READ(*,*)SHPAR(1),SHPAR(2),SHPAR(3)
            IF(SHPAR(1).LE.0)STOP
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
 1800    CONTINUE
      ELSEIF(CSHAPE.EQ.'THRELL'.OR.CSHAPE.EQ.'threll')THEN
         CSHAPE='THRELL'
         DO 1900 J=1,100
            WRITE(IDVOUT,*)'Enter length of one ellipsoid in x, y, z',
     &                     ' directions (0 0 0 to stop)'
            READ(*,*)SHPAR(1),SHPAR(2),SHPAR(3)
            IF(SHPAR(1).LE.0)STOP
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
 1900    CONTINUE
      ELSEIF(CSHAPE.EQ.'THRAEL'.OR.CSHAPE.EQ.'thrael')THEN
         CSHAPE='THRAEL'
         DO 2000 J=1,100
            WRITE(IDVOUT,*)'Enter length of one ellipsoid in x, y, z',
     &                     ' directions (0 0 0 to stop)'
            READ(*,*)SHPAR(1),SHPAR(2),SHPAR(3)
            IF(SHPAR(1).LE.0)STOP
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
 2000    CONTINUE
      ELSEIF(CSHAPE.EQ.'CONELL'.OR.CSHAPE.EQ.'conell')THEN
         CSHAPE='CONELL'
         DO 2100 J=1,100
            WRITE(IDVOUT,*)'Enter length of outer ellipsoid in x,y,z',
     &                     'directions (lattice units) (0 0 0 to stop)'
            READ(*,*)SHPAR(1),SHPAR(2),SHPAR(3)
            IF(SHPAR(1).LE.0)STOP
            WRITE(IDVOUT,*)'Enter length of inner ellipsoid in x,y,z',
     &                     'directions (lattice units)'
            READ(*,*)SHPAR(4),SHPAR(5),SHPAR(6)
            IF(SHPAR(4).LE.SHPAR(1).AND.
     &         SHPAR(5).LE.SHPAR(2).AND.
     &         SHPAR(6).LE.SHPAR(3))THEN
               CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,
     &              MXNAT,SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
               CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            ELSE
               WRITE(IDVOUT,*)'Input error: inner ellipsoid is not ',
     &                        'contained within outer ellipsoid'
            ENDIF
 2100    CONTINUE
      ELSEIF(CSHAPE.EQ.'BLOCKS'.OR.CSHAPE.EQ.'blocks')THEN
         CSHAPE='BLOCKS'
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,
     &               MXNAT,SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'BLK_AN'.OR.CSHAPE.EQ.'blk_an')THEN
         CSHAPE='BLK_AN'
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,
     &               MXNAT,SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'DW1996'.OR.CSHAPE.EQ.'dw1996')THEN
         CSHAPE='DW1996'
         WRITE(0,*)'Enter block size (lattice units)'
         READ(*,*)SHPAR(1)
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,
     &               MXNAT,SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'TWOSPH'.OR.CSHAPE.EQ.'twosph')THEN
         CSHAPE='TWOSPH'
         WRITE(0,*)'Enter length a_1 and diameter b_1 of 1st spheroid'
         READ(*,*)SHPAR(1),SHPAR(2)
         WRITE(0,*)'Enter length a_2 and diameter b_2 of 2nd spheroid'
         READ(*,*)SHPAR(3),SHPAR(4)
         WRITE(0,*)'Enter angle phi (deg) between axes a_1 and a_2'
         READ(*,*)SHPAR(5)
         WRITE(0,*)'Enter PRINAX=0 for a_1=(1,0,0),a_2=(0,1,0) in TF'
         WRITE(0,*)'            =1 for a_1,a_2=principal axes'
         READ(*,*)SHPAR(6)
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,
     &               MXNAT,SHPAR,NAT,IXYZ,ICOMP,IDVOUT,MXN3,NAT3)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSE
         WRITE(IDVOUT,*)'Do not know how to make shape = ',CSHAPE
         GOTO 1000
      ENDIF
 6000 FORMAT(' AX=',F7.4,' NAT=',I7)
 6100 FORMAT(' AX=',F7.4,' AY=',F7.4,' AZ=',F7.4,' NAT=',I7,' F=',F10.6)
 6200 FORMAT('    XV =',F7.4,'    YV =',F7.4,'    ZV =',F7.4,
     &       ' NAT=',I8,/,
     &       ' 2a_eff=',F7.4,' 2b_eff=',F7.4,' 2c_eff=',F7.4,
     &       ' err=',F8.7,/,
     &       '   y:x =',F7.4,'   z:x =',F7.4,'   y:z =',F7.4,/,
     &       '   x:y =',F7.4,'   x:z =',F7.4,'   z:y =',F7.4)
      END
