      PROGRAM CALLTARGET
      IMPLICIT NONE
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 00.06.12 (BTD): Added option NSPHER
C 02.02.13 (BTD): Added option PRISM3
C 02.11.12 (BTD): Added option SPHARM
C 03.11.06 (BTD): Modified to input parameters to generate random
C                 SPHARM target
c                 Added DX(3) to argument list of TARGET
c 03.11.08 (BTD): Added option GSPHER
c 04.03.31 (BTD): Replaced all WRITE(0, with WRITE(IDVOUT,
C 04.04.01 (BTD): Added NPY,NPZ to argument list of TARGET,
c                 so we can use new version of TARGET that supports
C                 periodic boundary conditions
C end history
C
C Copyright (C) 1993,1994,1995,1996,1997,2000,2002,2003,2004
C               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
C
      INTEGER MXNAT
      PARAMETER(MXNAT=500000)
C
C Derived parameters:
C
      INTEGER MXN3
      PARAMETER(MXN3=3*MXNAT)
C
C Variables:
C
      CHARACTER CDESCR*67,CFLSHP*80,CSHAPE*6
      INTEGER IDVSHP,IDVOUT,IOSHP,J,JJ,NAT,NAT3,NPY,NPZ
      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),DX(3),SHPAR(6)
      DOUBLE PRECISION DDX,DDY,DDZ,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=10
 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'
      WRITE(IDVOUT,*)'  NSPHER = multisphere (union of spheres)'
      WRITE(IDVOUT,*)'  PRISM3 = triangular prism'
      WRITE(IDVOUT,*)'  SPHARM = spherical-harmonic-generated surface'
      WRITE(IDVOUT,*)'  GSPHER = gaussian sphere'

c at this time, restrict to cubic lattice:

      DX(1)=1.
      DX(2)=1.
      DX(3)=1.

      READ(*,*)CSHAPE
      IF(CSHAPE.EQ.'TETRAH'.OR.CSHAPE.EQ.'tetrah')THEN
         CSHAPE='TETRAH'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(*,6000)SHPAR(1),NAT
         ENDDO
         STOP
      ELSEIF(CSHAPE.EQ.'SPHERE'.OR.CSHAPE.EQ.'sphere')THEN
         CSHAPE='SPHERE'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            RGYR2=0.
            XCM=0.
            YCM=0.
            ZCM=0.
            DO 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
            ENDDO
            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
         ENDDO
         STOP
      ELSEIF(CSHAPE.EQ.'ELLIPS'.OR.CSHAPE.EQ.'ellips')THEN
         CSHAPE='ELLIPS'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            XCM=0.
            YCM=0.
            ZCM=0.
            DO JJ=1,NAT
               X=IXYZ(JJ,1)
               Y=IXYZ(JJ,2)
               Z=IXYZ(JJ,3)
               XCM=XCM+X
               YCM=YCM+Y
               ZCM=ZCM+Z
            ENDDO
            XCM=XCM/REAL(NAT)
            YCM=YCM/REAL(NAT)
            ZCM=ZCM/REAL(NAT)
            X2=0.
            Y2=0.
            Z2=0.
            DO JJ=1,NAT
               DDX=IXYZ(JJ,1)-XCM
               DDY=IXYZ(JJ,2)-YCM
               DDZ=IXYZ(JJ,3)-ZCM
               X2=X2+DDX*DDX
               Y2=Y2+DDY*DDY
               Z2=Z2+DDZ*DDZ
            ENDDO
            X2=X2/NAT+1./12.
            Y2=Y2/NAT+1./12.
            Z2=Z2/NAT+1./12.
            ERR=20.*PI*SQRT(5.*REAL(X2*Y2*Z2))/(3.*REAL(NAT))-1.
            RXY=REAL(SQRT(X2/Y2))
            RYZ=REAL(SQRT(Y2/Z2))
            RZX=REAL(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
         ENDDO
         STOP
      ELSEIF(CSHAPE.EQ.'CYLNDR'.OR.CSHAPE.EQ.'cylndr')THEN
         CSHAPE='CYLNDR'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
         ENDDO
         STOP
      ELSEIF(CSHAPE.EQ.'RCTNGL'.OR.CSHAPE.EQ.'rctngl')THEN
         CSHAPE='RCTNGL'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
         ENDDO
      ELSEIF(CSHAPE.EQ.'HEXGON'.OR.CSHAPE.EQ.'hexgon')THEN
         CSHAPE='HEXGON'
         DO 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 length of 1 hexagon side'
            READ(*,*)SHPAR(2)
            CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &                  SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
         ENDDO
      ELSEIF(CSHAPE.EQ.'TWOELL'.OR.CSHAPE.EQ.'twoell')THEN
         CSHAPE='TWOELL'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
         ENDDO
      ELSEIF(CSHAPE.EQ.'TWOAEL'.OR.CSHAPE.EQ.'twoael')THEN
         CSHAPE='TWOAEL'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
         ENDDO
      ELSEIF(CSHAPE.EQ.'THRELL'.OR.CSHAPE.EQ.'threll')THEN
         CSHAPE='THRELL'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
         ENDDO
      ELSEIF(CSHAPE.EQ.'THRAEL'.OR.CSHAPE.EQ.'thrael')THEN
         CSHAPE='THRAEL'
         DO 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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &                  MXN3,NAT3,NPY,NPZ)
            CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            WRITE(IDVOUT,*)'NAT=',NAT
         ENDDO
      ELSEIF(CSHAPE.EQ.'CONELL'.OR.CSHAPE.EQ.'conell')THEN
         CSHAPE='CONELL'
         DO J=1,100
            WRITE(IDVOUT,*)'Enter length of outer ellipsoid (icomp=2) ',
     &                     '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 (icomp=1) ',
     &                     '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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &              MXN3,NAT3,NPY,NPZ)
               CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
            ELSE
               WRITE(IDVOUT,*)'Input error: inner ellipsoid is not ',
     &                        'contained within outer ellipsoid'
            ENDIF
         ENDDO
      ELSEIF(CSHAPE.EQ.'BLOCKS'.OR.CSHAPE.EQ.'blocks')THEN
         CSHAPE='BLOCKS'
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &               SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         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,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'DW1996'.OR.CSHAPE.EQ.'dw1996')THEN
         CSHAPE='DW1996'
         WRITE(IDVOUT,*)'Enter block size (lattice units)'
         READ(*,*)SHPAR(1)
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &               SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'TWOSPH'.OR.CSHAPE.EQ.'twosph')THEN
         CSHAPE='TWOSPH'
         WRITE(IDVOUT,*)'Enter length a_1 and diameter b_1 of 1st ',
     &                  'spheroid'
         READ(*,*)SHPAR(1),SHPAR(2)
         WRITE(IDVOUT,*)'Enter length a_2 and diameter b_2 of 2nd ',
     &                  'spheroid'
         READ(*,*)SHPAR(3),SHPAR(4)
         WRITE(IDVOUT,*)'Enter angle phi (deg) between axes a_1 and ',
     &                  'a_2'
         READ(*,*)SHPAR(5)
         WRITE(IDVOUT,*)'Enter PRINAX=0 for a_1=(1,0,0),a_2=(0,1,0) ',
     &                  'in TF'
         WRITE(IDVOUT,*)'            =1 for a_1,a_2 = principal axes'
         READ(*,*)SHPAR(6)
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &               SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'NSPHER'.OR.CSHAPE.EQ.'nspher')THEN
         CSHAPE='NSPHER'
         WRITE(IDVOUT,*)'Enter DIAMX = target extent in x-direction'
         READ(*,*)SHPAR(1)
         WRITE(IDVOUT,*)'Enter PRINAX=0 for a_1=(1,0,0),a_2=(0,1,0) ',
     &                  'in TF'
         WRITE(IDVOUT,*)'            =1 for a_1,a_2 = principal axes'
         READ(*,*)SHPAR(2)
         WRITE(IDVOUT,*)'Enter name of sphere parameter file (e.g., ',
     &             'tarnsp.par [in quotes])'
         READ(*,*)CFLSHP
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &               SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'PRISM3'.OR.CSHAPE.EQ.'prism3')THEN
         CSHAPE='PRISM3'
         WRITE(IDVOUT,*)'Enter a/d = first triangle side/d'
         READ(*,*)SHPAR(1)
         WRITE(IDVOUT,*)'Enter b/a , c/a, L/a'
         READ(*,*)SHPAR(2),SHPAR(3),SHPAR(4)
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &               SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'SPHARM'.OR.CSHAPE.EQ.'spharm')THEN
         CSHAPE='SPHARM'
         WRITE(IDVOUT,*)'Enter a_eff/d'
         READ(*,*)SHPAR(1)
         WRITE(IDVOUT,*)'Enter name of file with coefficients a_lm'
         WRITE(IDVOUT,*)'      or 0 to use random number generator'
         READ(*,*)CFLSHP
         IF(CFLSHP.EQ.'0')THEN
            WRITE(IDVOUT,*)'Enter power law index beta > 1'
            READ(*,*)SHPAR(3)
            WRITE(IDVOUT,*)'Enter Lmax > 1 (e.g., 5)'
            READ(*,*)SHPAR(4)
            WRITE(IDVOUT,*)'Enter <|a_{l0}|^2>/|a_{00}|^2'
            READ(*,*)SHPAR(5)
            WRITE(IDVOUT,*)'Enter integer seed > 0'
            READ(*,*)SHPAR(6)
         ENDIF
         WRITE(IDVOUT,*)'Enter PRINAX=0 for a_1=(1,0,0),a_2=(0,1,0) ',
     &                  'in TF'
         WRITE(IDVOUT,*)'             1 for a_1,a_2 = principal axes'
         READ(*,*)SHPAR(2)
c*** diagnostic
         WRITE(IDVOUT,*)'about to call target with ioshp=',ioshp
c***
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &               SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         CALL SIZER(MXNAT,NAT,IXYZ,LXYZ)
      ELSEIF(CSHAPE.EQ.'GSPHER'.OR.CSHAPE.EQ.'gspher')THEN
         CSHAPE='GSPHER'
         WRITE(IDVOUT,*)'Enter a_eff/d'
         READ(*,*)SHPAR(1)
         WRITE(IDVOUT,*)'Enter power law index beta > 1 (0 to input',
     &             ' a_lm from file targspher.alm)'
         READ(*,*)SHPAR(3)
         IF(SHPAR(3).EQ.0)THEN
            WRITE(IDVOUT,*)'OK -- will read input params from ',
     &                     'targspher.alm'
            CFLSHP='targspher.alm'
         ELSEIF(SHPAR(3).GT.1.)THEN
            WRITE(IDVOUT,*)'Enter Lmax > 0 (e.g., 5)'
            READ(*,*)SHPAR(4)
            WRITE(IDVOUT,*)'Enter <s^2> (e.g., 0.05) [this includes ',
     &                'all a_lm up to NMAX (=100)'
            READ(*,*)SHPAR(5)
            WRITE(IDVOUT,*)'Enter integer seed > 0'
            READ(*,*)SHPAR(6)
         ELSE
            WRITE(IDVOUT,*)'Invalid value for BETA'
         ENDIF
         WRITE(IDVOUT,*)'Enter PRINAX=0 for a_1=(1,0,0),a_2=(0,1,0) ',
     &                  'in TF'
         WRITE(IDVOUT,*)'             1 for a_1,a_2 = principal axes'
         READ(*,*)SHPAR(2)
c*** diagnostic
         WRITE(IDVOUT,*)'about to call target with ioshp=',ioshp
c***
         CALL TARGET(A1,A2,CSHAPE,CFLSHP,IDVSHP,IOSHP,CDESCR,MXNAT,
     &               SHPAR,DX,NAT,IXYZ,ICOMP,IDVOUT,
     &               MXN3,NAT3,NPY,NPZ)
         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





