      SUBROUTINE EXTEND(CMETHD,ICOMP,ICOMP2,IDVERR,IDVOUT,IOCC,IX,IY,IZ,
     &                  MXNX,MXNY,MXNZ,MXNAT,MXN3,NAT,NAT0,NAT3,
     &                  NX,NY,NZ)
C Arguments:
      CHARACTER*6 CMETHD
      INTEGER
     &   IDVERR,IDVOUT,MXNAT,MXN3,MXNX,MXNY,MXNZ,
     &   NAT,NAT0,NAT3,NX,NY,NZ
      INTEGER*2
     &   ICOMP(MXN3),ICOMP2(MXN3),IOCC(MXNAT),
     &   IX(MXNAT),IY(MXNAT),IZ(MXNAT)
C Local parameters:
      INTEGER MX235
      PARAMETER(MX235=136)
C Local variables:
      INTEGER IXA,IXMAX,IXMIN,IYA,IYMAX,IYMIN,
     &        IZA,IZMAX,IZMIN,JA,JA2,NXY
      INTEGER NF235(MX235)
      SAVE NF235
C***********************************************************************
C Given:
C    NAT0 = number of dipoles in real target
C    IX(1-NAT0) = x-index of dipoles in desired target
C    IY(1-NAT0) = y-index of dipoles in desired target
C    IZ(1-NAT0) = z-index of dipoles in desired target
C    ICOMP(1-NAT0,1-3) = composition info. for dipoles in desired target
C                       [with storage locations according to
C                        dimensioning ICOMP(MXNAT,3) ]
C    MXNX,MXNY,MXNZ = maximum allowed target size in x,y,z directions
C    MXNAT,MXN3 = dimensioning information
C
C Returns:
C    NAT = number of dipoles in extended target = NX*NY*NZ
C    NAT3 = 3*NAT
C    IX(1-NAT0) = x-index of dipoles in reordered physical target
C    IY(1-NAT0) = y-index of dipoles in reordered physical target
C    IZ(1-NAT0) = z-index of dipoles in reordered physical target
C    ICOMP(1-NAT,1-3) = composition inf. for dipoles (ICOMP=0 if vacant)
C                       [with storage locations according to
C                        dimensioning ICOMP(NAT,3) ]
C    NX = range of IX values (1 to NX)
C    NY = range of IY values (1 to NY)
C    NZ = range of IZ values (1 to NZ)
C
C Note: it is necessary to reorder IX,IY,IZ because DDSCAT calls routine
C    REDUCE to take list of polarizations for "extended" target and
C    collapse it to list of polarizations for "physical" target.
C    Similarly, REDUCE is also used to collapse vector of incident E
C    and vector of polarizabilities.
C
C B.T.Draine, Princeton Univ. Obs., 90.10.30
C History:
C 90.11. 8 (BTD): Changed DO...ENDDO to DO #...# CONTINUE
C 90.11.30 (BTD): Cosmetic changes.
C 90.11.30 (BTD): Modify to choose NX,NY,NZ from NF235.
C 90.12.05 (BTD): Change argument list; correct bug.
C 90.12.07 (BTD): Previous version was stupidly written. Rewritten.
C 90.12.13 (BTD): Corrected data list for NF235. Modified to allow
C                 CMETHD='CONVEX' option.
C 92.06.01 (BTD+PJF): Corrected major flaw in EXTEND: previous version
C                 neglected to reorder elements of IX,IY,IZ to
C                 correspond to possible reordering of occupied sites
C                 when extended target is constructed.  This error was
C                 previously overlooked because ordering was fortuitously
C                 unchanged by extend for targets generated by TARREC,
C                 TARELL, TARCYL, TARHEX.  Note that differential
C                 scattering cross sections computed previously using
C                 DDSCAT ver4a and using TARTET are not correct.
C 92.09.09 (BTD): extended values of NF235 up to 1024, and added
C                 warning if calling with IXMAX,IYMAX,or IZMAX > 1024
C 93.01.20 (BTD): added MXNX,MXNY,MXNZ to argument list and
C                 added tests to ensure that target is consistent with
C                 limits MXNX,MXNY,MXNZ
C 93.03.12 (BTD): extended NF235 up to 4096
C 94.06.20 (PJF): added code for NEWTMP 3D FFT
C 96.10.18 (BTD): changed NEWTMP to GPFAFT (Generalized Prime Factor
C                 Algorithm for Fourier Transform).
C end history
C Copyright (C) 1993,1996 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C Elements of NF235 are numbers.le.4096  which can be factored by 2,3,5:
      DATA NF235/2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40,
     &     45,48,50,54,60,64,72,75,80,81,90,96,100,108,120,125,128,135,
     &     144,150,160,162,180,192,200,216,225,240,243,250,256,270,288,
     &     300,320,324,360,375,384,400,405,432,450,480,486,500,512,540,
     &     576,600,625,640,648,675,720,729,750,768,800,810,864,900,960,
     &     972,1000,1024,1080,1125,1152,1200,1215,1250,1280,1296,1350,
     &     1440,1458,1500,1536,1600,1620,1728,1800,1875,1920,1944,2000,
     &     2025,2048,2160,2187,2250,2304,2400,2430,2500,2560,2592,2700,
     &     2880,2916,3000,3072,3125,3200,3240,3375,3456,3600,3645,3750,
     &     3840,3888,4000,4050,4096/
C*** First determine max., min values of input IX,IY,IZ:
      IXMIN=IX(1)
      IXMAX=IX(1)
      IYMIN=IY(1)
      IYMAX=IY(1)
      IZMIN=IZ(1)
      IZMAX=IZ(1)
      DO 100 JA=2,NAT0
         IF(IX(JA).LT.IXMIN)IXMIN=IX(JA)
         IF(IX(JA).GT.IXMAX)IXMAX=IX(JA)
         IF(IY(JA).LT.IYMIN)IYMIN=IY(JA)
         IF(IY(JA).GT.IYMAX)IYMAX=IY(JA)
         IF(IZ(JA).LT.IZMIN)IZMIN=IZ(JA)
         IF(IZ(JA).GT.IZMAX)IZMAX=IZ(JA)
  100 CONTINUE
C
C*** Now shift so that IX runs from 1 to IXMAX-IXMIN+1, etc.
      DO 110 JA=1,NAT0
         IX(JA)=IX(JA)+1-IXMIN
         IY(JA)=IY(JA)+1-IYMIN
         IZ(JA)=IZ(JA)+1-IZMIN
  110 CONTINUE
      IXMAX=IXMAX-IXMIN+1
      IYMAX=IYMAX-IYMIN+1
      IZMAX=IZMAX-IZMIN+1
C
      IF(IXMAX.LE.MXNX.AND.IYMAX.LE.MXNY.AND.IZMAX.LE.MXNZ)THEN
         WRITE(IDVOUT,6100)IXMAX,IYMAX,IZMAX
      ELSE
         WRITE(IDVOUT,6200)IXMAX,IYMAX,IZMAX,MXNX,MXNY,MXNZ
         CALL ERRMSG('FATAL','EXTEND',
     &   ' need to change MXNX,MXNY,MXNZ in DDSCAT and recompile')
      ENDIF
C
C*** Now determine NX,NY,NZ
      IF(CMETHD.EQ.'BRENNR')THEN
C Using FOURX: no restriction on NX,NY,NZ:
         NX=IXMAX
         NY=IYMAX
         NZ=IZMAX
      ELSEIF(CMETHD.EQ.'TMPRTN'.OR.CMETHD.EQ.'CONVEX'
     $   .OR.CMETHD.EQ.'GPFAFT')THEN
C Using Temperton's routine CFFT99F or Convex veclib routine C3DFFT or
C Temperton's new GPFA routine:
C     NX,NY,NZ must be factorable by 2,3,5  !!
C We require that NX,NY,NZ be selected from list NF235
C Check that list is long enough:
         IF(IXMAX.GT.NF235(MX235))THEN
            WRITE(IDVERR,*)'EXTEND> Error: IXMAX=',IXMAX,
     &                     '.gt.NF235(MX235)=',NF235(MX235)
            CALL ERRMSG('FATAL','EXTEND',
     &                  ' need to add to NF235 in EXTEND')
         ELSEIF(IYMAX.GT.NF235(MX235))THEN
            WRITE(IDVERR,*)'EXTEND> Error: IYMAX=',IYMAX,
     &                     '.gt.NF235(MX235)=',NF235(MX235)
            CALL ERRMSG('FATAL','EXTEND',
     &                  ' need to add to NF235 in EXTEND')
         ELSEIF(IZMAX.GT.NF235(MX235))THEN
            WRITE(IDVERR,*)'EXTEND> Error: IZMAX=',IZMAX,
     &                     '.gt.NF235(MX235)=',NF235(MX235)
            CALL ERRMSG('FATAL','EXTEND',
     &                  ' need to add to NF235 in EXTEND')
         ENDIF
         NX=0
         NY=0
         NZ=0
         DO 115 JA=1,MX235
            IF(IXMAX.LE.NF235(JA).AND.NX.EQ.0)NX=NF235(JA)
            IF(IYMAX.LE.NF235(JA).AND.NY.EQ.0)NY=NF235(JA)
            IF(IZMAX.LE.NF235(JA).AND.NZ.EQ.0)NZ=NF235(JA)
  115    CONTINUE
      ENDIF
      IF(NX.GT.MXNX.OR.NY.GT.MXNY.OR.NZ.GT.MXNZ)THEN
         WRITE(IDVOUT,6300)NX,NY,NZ,MXNX,MXNY,MXNZ
         CALL ERRMSG('FATAL','EXTEND',
     &   ' need to change MXNX,MXNY,MXNZ in DDSCAT and recompile')
      ENDIF
      NAT=NX*NY*NZ
      NAT3=3*NAT
C
C*** Now extend target: generate vectors of dipole properties
C        ICOMP(jx,jy,jz,1-3)=ICOMP(ja,1-3)=ICOMP(ja3)
C        IOCC(jx,jy,jz)=IOCC(ja)
C    with indices jx,jy,jz running from 1-NX,1-NY,1-NZ
C              or ja          "     "   1-(NX*NY*NZ)
C              or ja3         "     "   1-(3*NX*NY*NZ)
C
C
C First initialize ICOMP and IOCC to zero:
      DO 200 JA2=1,NAT
         IOCC(JA2)=0
         ICOMP2(JA2)=0
         ICOMP2(JA2+NAT)=0
         ICOMP2(JA2+2*NAT)=0
  200 CONTINUE
C Now reset values at occupied sites
      NXY=NX*NY
      DO 300 JA=1,NAT0
         JA2=IX(JA)+NX*(IY(JA)-1)+NXY*(IZ(JA)-1)
         IOCC(JA2)=1
         ICOMP2(JA2)=ICOMP(JA)
         ICOMP2(JA2+NAT)=ICOMP(JA+MXNAT)
         ICOMP2(JA2+2*NAT)=ICOMP(JA+2*MXNAT)
  300 CONTINUE
C
C Now overwrite original ICOMP
      DO 400 JA=1,NAT3
         ICOMP(JA)=ICOMP2(JA)
  400 CONTINUE
C
C Now reorder IX,IY,IZ to correspond to new ordering of occupied sites
      JA=0
      DO 500 JA2=1,NAT
         IF(IOCC(JA2).EQ.1)THEN
            JA=JA+1
            IXA=1+MOD(JA2-1,NX)
            IYA=1+MOD(JA2-IXA,NXY)/NX
            IZA=1+(JA2-IXA-NX*(IYA-1))/NXY
            IX(JA)=IXA
            IY(JA)=IYA
            IZ(JA)=IZA
         ENDIF
  500 CONTINUE
      RETURN
 6100 FORMAT(' >EXTEND: target extent in x,y,z directions =',I3,',',I3,
     &       ',',I3,' (in Target Frame)')
 6200 FORMAT(' >EXTEND: Fatal error!:',/,
     &       '          target extent in x,y,z directions =',I3,',',I3,
     &       ',',I3,/,
     &       '          exceeds dimension limits MXNX,MXNY,MXNZ=',I3,
     &       ',',I3,',',I3)
 6300 FORMAT(' >EXTEND: Fatal error after extending target!:',/,
     &       '          Extended target extent in x,y,z directions =',
     &       I3,',',I3,',',I3,/,
     &       '          exceeds dimension limits MXNX,MXNY,MXNZ=',I3,
     &       ',',I3,',',I3)
      END
