      SUBROUTINE ALPHA(CALPHA,CXALPH,CXE0R,CXEPS,ICOMP,AKR,NAT0,NAT3,
     &                 MXCOMP,MXN3)
C*** Arguments:
      CHARACTER*6 CALPHA
      INTEGER MXN3,MXCOMP,NAT0,NAT3
      COMPLEX CXALPH(MXN3),CXE0R(3),CXEPS(MXCOMP)
      INTEGER*2 ICOMP(MXN3)
      REAL AKR(3)
C
C*** Local Variables:
      CHARACTER CMSGNM*70
      INTEGER IC,L
      COMPLEX CXI,CXRR
      REAL AK1,AK2,B1,B2,EMKD,PI,SUM
      DATA CXI/(0.,1.)/
C***********************************************************************
C Given:
C       CALPHA = 'LATTDR' or 'DRAI88' or 'GOBR88' or 'LDRISO'
C                to specify method ('LATTDR' is recommended)
C       CXE0R(1-3) = polarization vector in lattice coordinates
C                    (assumed to be normalized)
C       CXEPS(1-NCOMP)=distinct values of dielectric constant
C       ICOMP(1-NAT3)=composition identifier for each lattice site and
C                     direction (ICOMP=0 if lattice site is unoccupied)
C       MXCOMP = dimensioning information
C       MXN3 = dimensioning information
C       NAT0 = number of sites in original target (i.e., nonvacuum sites)
C       NAT3 = 3*number of sites in extended target (including vacuum
C              sites)
C Returns:
C       CXALPHA(1-NAT3)=(polarizability/d^3) for each of 3 directions at
C                       each lattice site
C***
C If CALPHA = LATTDR:
C    Compute dipole polarizability using "Lattice Dispersion Relation"
C    of Draine & Goodman (1993,ApJ,March 10).  It is required that
C    polarizability be such that an infinite lattice of such dipoles
C    reproduce the continuum dispersion relation for radiation
C    propagating with direction and polarization of radiation incident
C    on the DDA target.  This is the recommended option.
C
C If CALPHA = DRAI88:
C    Compute dipole polarizability using
C           (1) eq. (2.03) of Draine (1988) (Clausius-Mossotti plus
C               radiative reaction correction)
C
C If CALPHA = GOBR88:
C    Compute dipole polarizability using
C           (1) radiative reaction correction from Draine (1988)
C           (2) O[(kd)^2] correction term used by
C               Goedecke & OBrien (1988) and Hage & Greenberg (1990)
C
C If CALPHA = LDRISO:
C    Compute dipole polarizability using "Isotropized Lattice Dispersion
C    Relation" of Draine & Goodman (1993,ApJ,March 10).  This replaces
C    direction- and polarization-dependent term in Lattice Dispersion
C    Relation with the average value for random direction and polarization.
C
C***
C    Note: CXALPH = polarizability/d^3
C    In the event that ICOMP=0, then we set CXALPH=1.
C***********************************************************************
C B.T.Draine, Princeton Univ. Obs.
C History:
C 90. 9.13 (BTD): Corrected error in DO loop limit.
C 90.11. 1 (BTD): Special treatment for "vacuum" sites in order
C                 to allow FFT treatment.
C 90.11. 2 (BTD): Set CXALPH=(1.,0.) at vacuum sites.
C 91. 4.30 (BTD): Modified to include both O[(kd)^2] correction term
C                 from Goedecke & Obrien (1988) in addition to
C                 radiative reaction correction.
C 91. 5. 7 (BTD): Modified to allow easy choice among three methods
C                 for computing polarizability.
C 91. 5. 7 (BTD): Added call to WRIMSG to record which method in use
C 91.05.08 (BTD): Added CALPHA to argument list.
C 91.05.09 (BTD): Added printing of kd and magnitude of correction
C                 terms.
C 91.05.13 (BTD): Experiment with use of approximate directional
C                 average for coefficient of CXEPS in Lattice
C                 Disperision Relation theory
C 91.05.13 (BTD): Corrected error in radiative reaction correction
C                 (error presumably introduced during last week)
C 91.05.14 (BTD): Added separate options LDRXYZ and LDRAVG
C 91.05.15 (BTD): Added option LDR000 to omit CXEPS-dependent
C                 correction term
C 91.05.30 (BTD): Changed LDRXYZ -> LDR100
C                 Added option LDR111
C 91.09.12 (BTD): Corrected error in numerical coefficient for
C                 LDRAVG case
C 91.09.17 (BTD): Eliminate options LDR000,LDRXYZ,LDRAVG
C                 Introduce option LATTDR (LATTice Dispersion Relation)
C                 which includes explicit dependence
C                 on direction and polarization state
C                 remove AK1 from argument list
C                 add AKR, CXE0R to argument list
C 92.05.14 (BTD): Introduce option LDRISO to experiment with
C                 using average directional correction term
C                 rather than using correction for incident direction
C                 and polarization
C 92.05.16 (BTD): Correct error in LDRISO option: average SUM should be
C                 3/15 rather than 4/15
C
C Copyright (C) 1993,1996 B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
      PI=4.*ATAN(1.)
      AK2=AKR(1)*AKR(1)+AKR(2)*AKR(2)+AKR(3)*AKR(3)
      AK1=SQRT(AK2)
      CXRR=-(AK1*AK2/1.5)*CXI
C*** EMKD = |m|*k_0*d , where |m|=refractive index
C                             k_0 = wave vector in vacuo
C                             d = lattice spacing
      EMKD=SQRT(CABS(CXEPS(1)))*AK1
C
C***********************************************************************
C*** Draine 1988:
C
      IF(CALPHA.EQ.'DRAI88')THEN
         WRITE(CMSGNM,FMT='(A,F6.4)')
     &         'Clausius-Mossotti plus radiative reaction for |m|kd=',
     &         EMKD
         CALL WRIMSG('ALPHA ',CMSGNM)
         DO 1000 L=1,NAT3
            IC=ICOMP(L)
            IF(IC.GT.0)THEN
C*** First compute Clausius-Mossotti polarizability:
               CXALPH(L)=(.75/PI)*(CXEPS(IC)-1.)/(CXEPS(IC)+2.)
C*** Now correct this for
C    (1) radiative-reaction
               CXALPH(L)=CXALPH(L)/(1.+CXALPH(L)*CXRR)
            ELSEIF(IC.EQ.0)THEN
C To avoid divisions by zero, etc., set CXALPH=1 for vacuum sites.
               CXALPH(L)=1.
            ENDIF
 1000    CONTINUE
         RETURN
C
C***********************************************************************
C*** Goedecke & OBrien 1988:
C
      ELSEIF(CALPHA.EQ.'GOBR88')THEN
         B1=-(4.*PI/3.)**(1./3.)*AK2
         WRITE(CMSGNM,FMT='(A,F6.4)')
     &         'Goedecke & OBrien (1988) correction for |m|kd=',EMKD
         CALL WRIMSG('ALPHA ',CMSGNM)
         DO 2000 L=1,NAT3
            IC=ICOMP(L)
            IF(IC.GT.0)THEN
C*** First compute Clausius-Mossotti polarizability:
               CXALPH(L)=(.75/PI)*(CXEPS(IC)-1.)/(CXEPS(IC)+2.)
C*** Now correct this for
C    (1) O[(kd)**2] correction from Goedecke and Obrien (1988)
               CXALPH(L)=CXALPH(L)/(1.+CXALPH(L)*B1)
C    (2) radiative-reaction
               CXALPH(L)=CXALPH(L)/(1.+CXALPH(L)*CXRR)
            ELSEIF(IC.EQ.0)THEN
C To avoid divisions by zero, etc., set CXALPH=1 for vacuum sites.
               CXALPH(L)=1.
            ENDIF
 2000    CONTINUE
         RETURN
C
C***********************************************************************
C*** Lattice dispersion relation
C
      ELSEIF(CALPHA.EQ.'LATTDR')THEN
         WRITE(CMSGNM,FMT='(A,F6.4)')
     &         'Lattice dispersion relation for |m|k_0d=',EMKD
         CALL WRIMSG('ALPHA ',CMSGNM)
C*** Compute sum (a_j*e_j)^2 , where a_j=unit propagation vector
C                                    e_j=unit polarization vector
         SUM=0.
         DO 2700 L=1,3
            SUM=SUM+(AKR(L)*CABS(CXE0R(L)))**2
 2700    CONTINUE
         SUM=SUM/AK2
         B1=-1.8915316*AK2
         B2=(0.1648469-1.7700004*SUM)*AK2
         DO 3000 L=1,NAT3
            IC=ICOMP(L)
            IF(IC.GT.0)THEN
C*** First compute Clausius-Mossotti polarizability:
               CXALPH(L)=(.75/PI)*(CXEPS(IC)-1.)/(CXEPS(IC)+2.)
C*** Determine polarizability by requiring that infinite lattice of
C    dipoles have dipersion relation of continuum.
               CXALPH(L)=CXALPH(L)/(1.+CXALPH(L)*(B1+CXEPS(IC)*B2))
C*** Radiative-reaction correction:
               CXALPH(L)=CXALPH(L)/(1.+CXALPH(L)*CXRR)
            ELSEIF(IC.EQ.0)THEN
C To avoid divisions by zero, etc., set CXALPH=1 for vacuum sites.
               CXALPH(L)=1.
            ENDIF
 3000    CONTINUE
         RETURN
      ELSEIF(CALPHA.EQ.'LDRISO')THEN
         WRITE(CMSGNM,FMT='(A,F6.4)')
     &         'Isotropic Lattice disp. rel. for |m|k_0d=',EMKD
         CALL WRIMSG('ALPHA ',CMSGNM)
C*** Compute sum (a_j*e_j)^2 , where a_j=unit propagation vector
C                                    e_j=unit polarization vector
C    Here experiment by taking average value of sum (a_j*e_j)^2 = 1/5
         SUM=0.2D0
         B1=-1.8915316*AK2
         B2=(0.1648469-1.7700004*SUM)*AK2
         DO 4000 L=1,NAT3
            IC=ICOMP(L)
            IF(IC.GT.0)THEN
C*** First compute Clausius-Mossotti polarizability:
               CXALPH(L)=(.75/PI)*(CXEPS(IC)-1.)/(CXEPS(IC)+2.)
C*** Determine polarizability by requiring that infinite lattice of
C    dipoles have dipersion relation of continuum.
               CXALPH(L)=CXALPH(L)/(1.+CXALPH(L)*(B1+CXEPS(IC)*B2))
C*** Radiative-reaction correction:
               CXALPH(L)=CXALPH(L)/(1.+CXALPH(L)*CXRR)
            ELSEIF(IC.EQ.0)THEN
C To avoid divisions by zero, etc., set CXALPH=1 for vacuum sites.
               CXALPH(L)=1.
            ENDIF
 4000    CONTINUE
         RETURN
      ENDIF
      END

