      SUBROUTINE GETFML(AKR,AK3,AKSR,DX,
     &                  CALPHA,CMDSOL,CMDFFT,CMDTRQ,CSHAPE,
     &                  CXADIA,CXAOFF,CXALPH,CXALOF,CXALDS,CXALOS,
     &                  CXE,CXE01R,CXE02R,CXEPS,
     &                  CXF11,CXF12,CXF21,CXF22,CXRLOC,
     &                  CXPOL,CXSC,CXSCR1,CXZC,CXZW,
     &                  EM1R,EM2R,ETASCA,
     &                  IBETH,IBETH1,ICOMP,IDVOUT,INIT,IOCC,
     &                  IORTH,IPHI,IPHI1,ITASK,IXYZ0,
     &                  ITNUM,MXITER,
     &                  LACE,LAXI,LCLM,LGI,LPI,LQI,LSC0,
     &                  MXCOMP,MXCXSC,MXN3,MXNAT,
     &                  MXNX,MXNY,MXNZ,MXPHI,MXSCA,MYID,
     &                  NAT,NAT0,NAT3,NAVG,NCOMP,NSCAT,NX,NY,NZ,
     &                  PHI,PHIN,PIA2,
     &                  QABS,QBKSCA,QEXT,QPHA,QSCA,QSCAG,QSCAG2,
     &                  QTRQAB,QTRQSC,
     &                  SCRRS1,SCRRS2,SHPAR,THETAN,TOL,TIMERS,
     &                  MXTIMERS,NTIMERS)
C
C***********************************************************************
C Function of GETFML is to return the scattering function fml in
C preselected scattering directions.
C
C Given:
C       AKR(1-3)=(k_x,k_y,k_z)*d for incident wave [in Target Frame]
C       AK3     =(kd)**3
C       AKSR(1-3,1-NSCAT)=(k_x,k_y,k_z)*d for NSCAT scattering directions
C       DX(1-3) =(d_x/d,d_y/d,d_z/d) where d_x,d_y,d_z=x,y,z lattice spacing
C                and d=(d_x*d_y*d_z)**(1/3)=effective lattice spacing
C       CALPHA  =descriptor of method used for assigning polarizabilities
C               =LATTDR or DRAI88 or GOBR88
C       CMDSOL  =descriptor of method used for iterative solution
C       CMDFFT  =descriptor of method used for FFTs
C       CMDTRQ  =descriptor of whether or not to compute torques
C       CSHAPE  =descriptor of target shape, needed by subroutine ALPHA
C       CXE01R(1-3)=incident polarization state 1 at origin [in TF]
C       CXE02R(1-3)=incident polarization state 2 at origin [in TF]
C       CXEPS(1-NCOMP)=dielectric constant for compositions 1-NCOMP
C       EM1R(1-3,1-NSCAT)=unit scat. polarization vectors 1 in TF
C       EM2R(1-3,1-NSCAT)=unit scat. polarization vectors 2 in TF
C       ETASCA  =parameter controlling number of scattering angles used
c                for calculation of radiation force, <cos>, <cos^2>, and
c                radiation torque
C       IBETH   =MYID+IBETH1 if first time through combined BETA/THETA 
C                orientation loop
C       IBETH1  =starting value of IBETH (see above)
C       ICOMP(1-NAT3)=x,y,z "composition" for sites 1-NAT
C       IDVOUT  =device for running output
C       INIT    =0,1,2 for choice of |x0> for CCG method
C       IOCC(1-NAT)=0,1 if site in extended target is vacant,occupied
C       IORTH   =1,2 to do 1,2 orthogonal pol states
C       IPHI    =which phi value for target orientation
C       IPHI1   =starting value of IPHI (see above)
C       ITASK    not used
C       IXYZ0(1-MXNAT,1-3)=lattice coordinates for sites 1-NAT (in TF)
C                with sites 1-NAT0 in list being the occupied sites.
C       LACE,LAXI,LCLM,LGI,LPI,LQI,LSC0=integers used to assign locations
C                in scratch array
C       MXCOMP  =dimensioning info: maximum number of allowed compositions
C       MXCXSC  =dimensioning info for complex scratch space
C       MXN3    =dimensioning info (3*max number of sites)
C       MXNAT   =dimensioning info (max number of sites)
C       MXNX    =dimensioning info (max x extent of target)
C       MXNY    =dimensioning info (max y extent of target)
C       MXNZ    =dimensioning info (max z extent of target)
C       MXPHI   =dimensioning info (max number of phi vals for targ. orient)
C       MXSCA   =dimensioning info (max number of scat. dirs for f_ml)
C       MYID    =parallel process identifier (=0 if only 1 process)
C       NAT     =number of sites in extended target
C       NAT0    =number of sites in original target
C       NAT3    =3*NAT
C       NCOMP   =number of different dielectric tensor elements in target
C       NSCAT   =number of scat. dirs for f_ml
C       NX      =x extent of extended target
C       NY      =y extent of extended target
C       NZ      =z extent of extended target
C       PHI(1-NPHI)=phi values target orientation
C       PHIN(1-NSCAT)=phi values for scat. dirs for f_ml comp.
C       PIA2    =\pi*(3*NAT/4\pi)^{2/3} (NAT=number of sites in original target)
C       SHPAR(1-6)=target shape parameters, needed by subroutine ALPHA
C       THETAN(1-NSCAT)=theta values for scat. dirs for f_ml comp
C       TOL     =tolerance for terminating conjugate gradient iteration
C
C and scratch space:
C       CXRLOC(1-MXCOMP+1,3,3)
C       CXSC(1-MXCXSC)=scratch space
C       CXSCR1(1-MXN3)=scratch space
C       CXZC(1-MXNX+1,1-MXNY+1,1-MXNZ+1,1-6)=scratch space
C       CXZW(1-MXNAT,1-24)=scratch space
C       SCRRS1(1-MXN3)=scratch space
C       SCRRS2(1-MXNAT)=scratch space
C
C Returns:
C
C       CXADIA(1-3,1-NAT)=diagonal elements of "A matrix"
C       CXAOFF(1-3,1-NAT)=off-diagonal elements of 3x3 blocks on
C                         diagonal of "A matrix"
C       CXALPH(1-3,1-NAT)=diagonal elements of 3x3 polarizability
C                         tensor for dipoles 1-NAT (in TF)
C       CXALOF(1-3,1-NAT)=off-diagonal elements of 3x3 polarizability
C                         tensor for dipoles 1-NAT
C       CXALDS(J,1-3)=(alpha_11,alpha_22,alpha_33)/d^3 for dipole J=1-NAT
C                     where alpha_ij is computed using Rahmani et al. (2002) 
C                     prescription. Serves as storage space so that the 
C                     calculation need not be done at every ALPHA call. 
C                     Only used if CALPHA.EQ.'SCLDR'
C       CXALOS(J,1-3)=(alpha_23,alpha_31,alpha_12)/d^3 for dipole J=1-NAT
C                     Off-diagonal polarizability elements corresponding 
C                     to the diagonal elements in CXALDS.
C       CXE(1-NAT3)=incident x,y,z E field at dipoles 1-NAT (in TF)
C       CXF11(1-NSCAT)=scattering matrix element f_11 for NSCAT dirs
C       CXF12(1-NSCAT)=                          f_12
C       CXF21(1-NSCAT)=                          f_21
C       CXF22(1-NSCAT)=                          f_22
C       CXPOL(1-NAT3)=x,y,z polarization of dipoles 1-NAT in TF
C       QABS(1-2)=Q_abs=C_abs/(PIA2*d**2) for incident pols 1,2
C       QBKSCA(1-2)=diff.scatt.cross section/(PIA2*d^2) for backscat
C                   for inc.pols.1,2
C       QEXT(1-2)=Q_ext=C_ext/(PIA2*d**2) for incident pols 1,2
C       QPHA(1-2)=phase shift cross section for incident pols 1,2
C       QSCA(1-2)=Q_sca=C_sca/(PIA2*d**2) for incident pols 1,2
C       QSCAG(1-3,1-2)=<cos(theta)>*Q_sca for incident pols 1,2
C                      <sin(theta)*cos(phi)>*Q_sca for incident pols 1,2
C                      <sin(theta)*sin(phi)>*Q_sca for incident pols 1,2
C                      [QSCAG(1-3,1-2) is in Lab Frame]
C       QSCAG2(1-2)   =<cos^2(theta)>*Q_sca for inciden tpols 1,2
C       QTRQAB(1-3,1-2)=vector torque cross section/(PIA2*d^2) for
C                      torque due to absorption, along axes 1-3, for
C                      incident pols 1,2
C                      [QTRQAB(1-3,1-2) is in Lab Frame]
C       QTRQSC(1-3,1-2)=vector torque cross section/(PIA2*d^2) for
C                      torque due to scattering, along axes 1-3, for
C                      incident pols 1,2
C                      [QTRQSC(1-3,1-2) is in Lab Frame]
C       TIMERS(1-12)=timing information
C       ITNUM(1-2)= number of iterations taken for polarizations 1 and 2
C       MXITER    = maximum number of iterations allowed.
C
C Requires:
C	MATVEC = external routine to compute A*x
C	CMATVEC = external routine to compute conjg(A')*x
C	where A is matrix such that A*pol=E
C	and x is arbitrary vector
C
C B.T.Draine, Princeton Univ. Observatory, 1990.
C History:
C 90.11.06 (BTD): modified to change argument list and pass array
C                 dimensions.
C 90.11.29 (BTD): further modifications, including arguments
C                 changed calls to EVALE
C 90.11.29 (BTD): changes to use REDUCE so that computations in
C                 EVALQ and SCAT are restricted to occupied sites.
C 90.11.30 (BTD): multiple changes to reduce storage requirements
C 90.12.03 (BTD): change ordering of XYZ0
C 90.12.10 (BTD): remove XYZ0 and use IXYZ0 instead
C 90.12.13 (BTD): add new argument to calls to EVALQ
C 91.01.03 (BTD): modified so that when IORTH=1 no attempt is made
C                 to compute f_{ml} for "standard" definition of
C                 incident pol. states defined by scattering plane.
C 91.05.09 (BTD): after call to SCAT, adjust QSCA and QSCAG to make
C                 QSCA=QEXT-QABS
C 91.05.09 (BTD): eliminate redundant write statement
C 91.08.14 (BTD): add QBKSCA to argument list for GETFML
C                 add CBKSCA to argument list for SCAT
C                 compute QBKSCA from CBKSCA
C 91.09.17 (BTD): move call to subroutine ALPHA from DDSCAT to GETFML
C                 (since polarizability from Lattice Dipersion Relation
C                 depends on direction of propagation and polarization)
C                 add CALPHA, CXEPS, ICOMP, MXCOMP to argument list for
C                 GETFML
C 93.01.14 (BTD): change method for computing QSCA to use result from
C                 SCAT when albedo << .01 , to use (QEXT-QABS) when
C                 albedo >> .01, and to smoothly join these limits.
C 93.03.11 (BTD): deleted all code associated with unused variable
C                 CMACHN (originally included to identify machine/OS)
C 93.07.09 (BTD): modify method for computing QSCA to use .03 as
C                 the dividing point rather than .01 .
C 93.11.23 (BTD): added SAVE E02 to preserve value of E02 between calls
C                 [to eliminate problem encountered on Silicon Graphics
C                 machines when IPHI>1]
C 94.06.20 (PJF): Added DTIME to argument list for TIMEIT
C 95.06.14 (BTD): Changed CSCAG from scalar to CSCAG(3) vector
C                 where CSCAG(1)=C_sca*<cos(theta)>
C                 Changed QSCAG(1-2) to QSCAG(1-3,1-2)
C                 Added CTRQSC(1-3) to argument list of SCAT
C                 Added QTRQSC(1-3,1-2) to argument list of GETFML
C 95.06.15 (BTD): Added variable CXE to argument list of SCAT
C                 Added CTRQAB(1-3) to argument list of SCAT
C                 Added QTRQAB(1-3,1-2) to argument list of GETFML
C 95.06.16 (PJF+: Modified to eliminate call to DDACCG and replace
C           BTD): with code to call PETR (a modularized implementation
C                 of the Petravic-Kuo CCG algorithm).  With this change
C                 it becomes easier to substitute other implementations
C                 of CCG (or other iterative methods, such as QMR).
C 95.06.19 (BTD): Added CMDSOL to argument list to select CCG method
C               : Added CMDTRQ to argument list to allow torque
C                 calculation to be skipped
C 95.07.10 (BTD): Changed calls to TIMEIT (was not doing timing
C                 properly)
C 95.07.17 (BTD): Relocated call to EVALQ.
C                 Call REDUCE to "reduce" CXE as well as CXP, prior
C                 to calling EVALQ and SCAT.
C 95.07.20 (BTD): Added scratch space SCRRS2 for use by SCAT
C                 Added scratch array CXZW(1-MXNAT,10-12) to SCAT
C                 argument list
C 95.07.27 (BTD): Revised way in which CXALPH is "reduced" prior to
C                 calls to EVALQ and SCAT.
C                 Revised to compute CXALPH for each incident E field
C                 [Only reason this is needed is because of slight
C                 dependence of polarizabilities on incident pol state]
C                 Added scratch space CXSCR1 to argument list, to store
C                 first polarization solution while solving for second
C 95.08.11 (BTD): Relocated CALL CINIT to precede IF statements for
C                 selection of solution method.
C 95.08.14 (BTD): Added COMMON/NORMERR/ERRSCAL to support desired
C                 normalization of error printed out by subroutine
C                 PROGRESS (part of cgcommon.f)
C 96.11.14 (PJF): ADD TIMERS, MXTIMERS, NTIMERS  to formal parameters
C                 modify code to return timer results
C                 TIMERS contains information needed to time the
C                 code (for example CPU time or number of iterations)
C                 timers(1) --- CG CPU time for all iterations
C                 timers(2) --- number of iterations needed
C                 timers(3) --- not used
C                 timers(4) --- scat CPU time
C                 ... see code for timers(5-12)
C 96.11.21 (BTD): declared MXTIMERS,NTIMERS,
C 97.02.20 (BTD): removed SNORM2 from EXTERNAL statement
C 97.11.01 (BTD): added DX(1-3) to argument list of GETFML
C                 and to argument lists for EVALE, ALPHA, and SCAT
C                 [development of DDSCAT.6.0]
C 97.12.26 (BTD): added CXALOF to argument list of GETFML
C                 and to argument list of ALPHA, EVALA
C                 [development of DDSCAT.6.0]
C 98.01.01 (BTD): added 2 calls to new routine RESTORE to expand
C                 CXADIA and CXAOFF back to 3*NAT elements after they
C                 have been "reduced" to 3*NAT0 for efficient 
C                 execution of EVALQ
C 98.04.27 (BTD): added declarations for arguments CXAOFF and CXALOF
C                 [development of DDSCAT.6.0]
C                 only call CXALPH once for each orientation, since
C                 in new form of Lattice Dispersion Relation the
C                 polarizability does not depend on polarization,
C                 although it does depend on direction of propagation
C 98.11.18 (BTD): corrected misleading comments apropos EM1R,EM2R
C 98.12.04 (BTD): located error which resulted in subsequent incorrect
C                 evaluation of Mueller scattering matrix.
C                 Problem arose because at some point it was decided to
C                 convert to usual convention for incident polarization
C                 states 1 and 2 for computation of f_ml (CXF11,...)
C                 Unfortunately, this was forgotten, and subroutine
C                 GETMUELLER was written assuming that incident pol. 
C                 states l=1 and 2 referred to by f_ml were the ones 
C                 specified by the user in ddscat.par.  Because this in
C                 fact does seem preferable, we conform to this 
C                 prescription and have disabled the portion of GETFML
C                 which converted to the "usual" convention.  Note
C                 that since f_ml is now entirely for internal use,
C                 (except when IORTH=1, but then we do not compute
C                 Muller matrix) there is no motivation to adopt usual 
C                 convention.
C 98.12.07 (BTD): Experiment to verify claimed accuracy from PIM
C                 New module has been inserted into code below but
C                 commented out after verifying that reported errors
C                 appear to be close to "true" errors.
C                 However, module can be reactivated by uncommenting
C                 if such verification is desired in future.  Search
C                 below for string "98.12.07" to find the 2 modules. 
C 98.12.16 (BTD): Increase upper limit on number of iterations from 300
C                 to 10000
C 03.01.29 (BTD): returned CXE0R to argument list for ALPHA
C                 reactived calls to ALPHA for different polarizations
C                 since now using LATTDR again instead of GKDLDR
c 03.04.12 (BTD): added variables ITNUM(2) and MXITER to argument list
C                 and modified code to assign values to them
c                 added veriables ITERN and ITERMX
c 03.10.23 (BTD): modified argument list for SCAT:
c                    eliminated ICTHM and IPHIM
c                    added CSCAG2 and NAVG
c                 modified argument list of GETFML
c                    eliminated ICTHM and IPHIM
c 03.10.24 (BTD): added ETASCA to argument list
c                 and to argument list of SCAT
c 04.03.31 (BTD): changed WRITE(0 to WRITE(IDVOUT
c 04.05.22 (BTD): cleanup: comment out declarations of unused variables
c                 CXVAR1,CXVAR1,CXONE,CXZERO
c                 remove IF(IPHIM.GT.1) test, and always store
c                 first polarization (even if only doing one
c                 target orientation, overhead is not significant)
c 04.05.22 (BTD): fixed bug in computation of true error
c                 was summing from 3*I+1 to 3*I+3
c                 now sum from 3*I-2 to 3*I
C end history
C
C Copyright (C) 1993,1994,1995,1996,1997,1998,2003,2004
C               B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C
      IMPLICIT NONE
C
C Arguments:
C
      CHARACTER CALPHA*6,CMDSOL*6,CMDFFT*6,CMDTRQ*6,CSHAPE*6
C
      INTEGER IBETH,IBETH1,ICTHM,IDVOUT,INIT,IORTH,IPHI,IPHI1,IPHIM,
     &        ITASK,LACE,LAXI,LCLM,LGI,LPI,LSC0,LQI,
     &        MXCOMP,MXCXSC,MXN3,MXNAT,MXNX,MXNY,MXNZ,MXPHI,MXSCA,
     &        MXTIMERS,MYID,
     &        NAT,NAT0,NAT3,NAVG,NCOMP,NSCAT,NTIMERS,NX,NY,NZ

      INTEGER MXITER
      INTEGER ITNUM(2)
C
      INTEGER*2 ICOMP(MXN3),IOCC(MXNAT),IXYZ0(MXNAT,3)
C
      REAL AK3,ETASCA,PIA2,TOL
C
      REAL AKR(3),AKSR(3,MXSCA),DX(3),EM1R(3,MXSCA),EM2R(3,MXSCA),
     &     PHI(MXPHI),PHIN(MXSCA),
     &     QABS(2),QBKSCA(2),QEXT(2),QPHA(2),QSCA(2),QSCAG(3,2),
     &     QSCAG2(2),QTRQAB(3,2),QTRQSC(3,2),
     &     SCRRS1(MXN3),SCRRS2(MXNAT),SHPAR(6),
     &     THETAN(MXSCA),TIMERS(MXTIMERS)
C
      COMPLEX CXADIA(MXN3),CXALPH(MXN3),CXALOF(MXN3),CXAOFF(MXN3),
     &        CXALDS(NAT,3),CXALOS(NAT,3),
     &        CXE(MXN3),CXE01R(3),CXE02R(3),CXEPS(MXCOMP),
     &        CXF11(MXSCA),CXF12(MXSCA),CXF21(MXSCA),CXF22(MXSCA),
     &        CXRLOC(MXCOMP+1,3,3),
     &        CXPOL(MXN3),CXSC(MXCXSC),CXSCR1(MXN3),
     &        CXZC(MXNX+1,MXNY+1,MXNZ+1,6),
     &        CXZW(MXNAT,24)
C
C Common:
C
      INTEGER IDVOUT2,ITERMX,ITERN
      REAL ERRSCAL
C-----------------------------------------------------------------------
      COMMON/NORMERR/ERRSCAL,IDVOUT2,ITERMX,ITERN
C-----------------------------------------------------------------------
C
C Local variables
C
c      COMPLEX CXONE,CXZERO
c      COMPLEX CXVAR1,CXVAR2
      COMPLEX CXE0R(3)
C
      INTEGER I,J,JO,NAT03
C
      INTEGER IPAR(13)
C
      REAL
     &  CABS,CBKSCA,CEXT,CPHA,CSCA,CSCAG2,COSPHI,
     &  DTIME,DUMMY,E02,FALB,SINPHI
C
      REAL CSCAG(3),CTRQAB(3),CTRQSC(3),SPAR(6)
C
      SAVE E02
C      SAVE CXONE,CXZERO
C
      EXTERNAL CMATVEC,DIAGL,MATVEC,PCSUM,PROGRESS,PSCNRM2
C
C      DATA CXONE/(1.0,0.)/,CXZERO/(0.,0.)/
      IDVOUT2=IDVOUT
      NAT03=3*NAT0
C
C*** Compute fml directly only if IPHI=1
C    Otherwise use previously computed fml values to obtain new fml
C
      IF(IPHI.EQ.1)THEN
C
C Compute dipole polarizabilities for this direction of
C propagation.  Note that prescription now being used for
C dipole polarizabilities is independent of polarization of
C the incident electric field, therefore we need only call
C ALPHA once for each new direction of incidence.
C
C collinge: the above statement is incorrect, I think. I am 
C           moving the call to alpha inside the polarization state
C           loop.
C
C         CALL ALPHA(AKR,CALPHA,CXALDS,CXALPH,CXALOF,CXALOS,
C     &        CXE0R,CXEPS,CXSC,CXSCR1,CXZC,CXZW,DX,IBETH,IBETH1,
C     &        ICOMP,IOCC,IPHI,IPHI1,IXYZ0,JORTH,MYID,MXCOMP,MXNAT,
C     &        MXN3,NAT,NAT0,NAT3,NCOMP,NX,NY,NZ,CXRLOC,CSHAPE,SHPAR)
C
C*** call EVALA to prepare A matrix elements
C
C         CALL EVALA(CXADIA,CXAOFF,CXALPH,CXALOF,MXN3,NAT)

         DO JO=1,IORTH
            IF(JO.EQ.1)THEN
               CXE0R(1)=CXE01R(1)
               CXE0R(2)=CXE01R(2)
               CXE0R(3)=CXE01R(3)
            ELSE
               CXE0R(1)=CXE02R(1)
               CXE0R(2)=CXE02R(2)
               CXE0R(3)=CXE02R(3)
C collinge: restore calls are not needed now.
C               CALL RESTORE(CXADIA,CXONE,IOCC,MXN3,MXNAT,NAT,NAT0)
C               CALL RESTORE(CXAOFF,CXZERO,IOCC,MXN3,MXNAT,NAT,NAT0)
            ENDIF
            E02=0.
            DO I=1,3
               E02=E02+REAL(CXE0R(I)*CONJG(CXE0R(I)))
            ENDDO
C
C Compute quantity used for "normalizing" error:
C
            ERRSCAL=SQRT(NAT0*E02)
C
C*** call EVALE for NAT sites

            CALL EVALE(CXE0R,AKR,DX,IXYZ0,MXNAT,MXN3,NAT,NAT0,
     &                 NX,NY,NZ,CXE)

C collinge: relocated ALPHA and EVALA calls here.

C***call ALPHA to determine polarizabilities at NAT sites
C    (note: this has to be within the loop over directions and
C     polarizations because Lattice Dispersion Relation polarizabilities
C     depend on direction of propagation and on polarization state)

            CALL ALPHA(AKR,CALPHA,CXALDS,CXALPH,CXALOF,CXALOS,
     &           CXE0R,CXEPS,CXSC,CXSCR1,CXZC,CXZW,DX,IBETH,IBETH1,
     &           ICOMP,IOCC,IPHI,IPHI1,IXYZ0,JO,MYID,MXCOMP,MXNAT,
     &           MXN3,NAT,NAT0,NAT3,NCOMP,NX,NY,NZ,CXRLOC,CSHAPE,SHPAR)

C*** call EVALA to prepare A matrix elements

            CALL EVALA(CXADIA,CXAOFF,CXALPH,CXALOF,MXN3,NAT)

C*** first call to timeit:

            CALL TIMEIT(' SOLVER',DTIME)

C Version 4c called DDACCG at this point.  This call to DDACCG is
C replaced with code to
C (1) define parameters IPAR(1),IPAR(4),IPAR(10),SPAR(1)
C (2) call nuller to "clean" CXE (i.e., set to zero at unoccupied sites).
C (3) initialize first guess for cxpol=0
C
C Notation:
C ipar(1) LDA         LDA (Leading dimension of a)
C ipar(2) N           N   (Number of rows/columns of a)
C ipar(3) BLKSZ       N   (Size of block of data; used when data is
C                          partitioned using cyclic mode)
C ipar(4) LOCLEN      N   (Number of elements stored locally; for
C                          sequential=n)
C ipar(5) BASISDIM    C=basis=10 (Dimension of orthogonal basis, used in
C                                 GMRES)
C ipar(6) NPROCS      -1 (Number of processors)
C ipar(7) PROCID      -1 (Processor identification)
C ipar(8) PRECONTYPE PRET (=1 Type of preconditioning
C                     0-no preconditioning, 1-left, 2-right, 3-symmetric
C ipar(9) STOPTYPE   STOPT (Type of stopping criteria used)
C ipar(10) MAXIT     MAXIT (=int(n/2) Maximum number of iterations allowed)
C      IPAR(11) = -1 itno   (Number of iterations executed)
C      IPAR(12) = -1 status (On exit of iterative method; 0-converged)
C      IPAR(13) = -1 steperr 
C
            IPAR(1)=MXN3
            IPAR(2)=NAT3
            IPAR(3)=NAT3
            IPAR(4)=NAT3
            IPAR(6)=-1
            IPAR(7)=-1

c Increase upper limit from 300 to 10000 iterations
c            IPAR(10)=MIN(300,NAT03)

            IPAR(10)=MIN(10000,NAT03)
            MXITER=IPAR(10)

c pass information on max.no. of iterations allowed to COMMON/NORMERR/

            ITERMX=IPAR(10)
C
            SPAR(1)=TOL
C
C Clean CXE:
C
            IF(NAT0.LT.NAT)CALL NULLER(CXE,IOCC,MXNAT,MXN3,NAT)
C
C Initialize CXPOL (first guess)
C
            CALL CINIT(NAT3,CMPLX(0.,0.),CXPOL,1)
C
C Iterate to improve CXPOL
C
            IF(CMDSOL.EQ.'PETRKP')THEN
               IPAR(5)=-1
               IPAR(8)=1
C
C Note: PETR cannot be used with STOPTYPE=2 -- code crashes when
C calling STOPCRIT.  Stick with STOPTYPE=5
C
               IPAR(9)=5
               CALL PETR(CXPOL,CXE,CXSC,MXN3,IPAR,SPAR,MATVEC,CMATVEC)
C
C-----------------------------------------------------------------------
C 98.12.07 BTD Experiment to verify claimed accuracy from PETR.
C              This module is superfluous and could be excised without
C              affecting computed results, thereby eliminating
C              unnecessary computations.

               CALL MATVEC(CXPOL,CXSC,IPAR)
               DUMMY=0.
               DO I=1,NAT
                  IF(IOCC(I).GE.1)THEN
                     DO J=3*I-2,3*I
                        DUMMY=DUMMY+
     &                     REAL(CONJG(CXSC(J)-CXE(J))*(CXSC(J)-CXE(J)))
                     ENDDO
                  ENDIF
               ENDDO
               DUMMY=SQRT(DUMMY/(NAT0*E02))
               WRITE(IDVOUT,9200)DUMMY
C-----------------------------------------------------------------------
C
C second call to timeit:
C
               CALL TIMEIT('PETRKP',DTIME)
               TIMERS(1)=DTIME
               TIMERS(2)=FLOAT(IPAR(11))
            ELSEIF(CMDSOL.EQ.'PBCGST')THEN
               IPAR(5)=-1
               IPAR(8)=1

C PIMCBICGSTAB appears to be about 25% slower (per iteration) when
C called with STOPTYPE=2 rather than 5.  Therefore use STOPTYPE=2
C even though actual stopping criterion used is complicated by
C preconditioning.

               IPAR(9)=5

               CALL PIMCBICGSTAB(CXPOL,CXE,CXSC,IPAR,SPAR,MATVEC,
     &                           DIAGL,
     &                           DUMMY,PCSUM,PSCNRM2,PROGRESS)

C----------------------------------------------------------------------
C 98.12.07 BTD Experiment to verify claimed accuracy from PIM.
C              This module is superfluous and could be excised without
C              affecting computed results, thereby eliminating
C              unnecessary computations.

               CALL MATVEC(CXPOL,CXSC,IPAR)
               DUMMY=0.
               DO I=1,NAT
                  IF(IOCC(I).GE.1)THEN
                     DO J=3*I-2,3*I
                        DUMMY=DUMMY+
     &                     REAL(CONJG(CXSC(J)-CXE(J))*(CXSC(J)-CXE(J)))
                     ENDDO
                  ENDIF
               ENDDO
               DUMMY=SQRT(DUMMY/(NAT0*E02))
               WRITE(IDVOUT,9200)DUMMY
C----------------------------------------------------------------------

C second call to timeit:

               CALL TIMEIT('PBCGST',DTIME)

               TIMERS(1)=DTIME

               TIMERS(2)=FLOAT(IPAR(11))

            ELSE
               STOP'Error -- invalid CMDSOL in getfml'
            ENDIF

C*** Reduce the vectors CXADIA, CXAOFF, CXPOL and CXE to retain only 
C    occupied sites, to eliminate unnecessary calculations for 
C    unoccupied sites when calling EVALQ and SCAT

            CALL REDUCE(CXADIA,IOCC,MXN3,MXNAT,NAT,NAT0)
            CALL REDUCE(CXAOFF,IOCC,MXN3,MXNAT,NAT,NAT0)
            CALL REDUCE(CXE,IOCC,MXN3,MXNAT,NAT,NAT0)
            CALL REDUCE(CXPOL,IOCC,MXN3,MXNAT,NAT,NAT0)

            ITNUM(JO)=ITERN

C*** Store reduced polarization vector P
C    for use in subsequent computations for other phi values
C    CXSCR1     for JO=1
C    CXSC(LACE) for JO=2 (this scratch space no longer needed by solver)

cdelete            IF(IPHIM.GT.1)THEN
               IF(JO.EQ.1)THEN
                  CALL COPYIT(CXPOL,CXSCR1,NAT03)
               ELSEIF(JO.EQ.2)THEN
                  CALL COPYIT(CXPOL,CXSC(LACE),NAT03)
               ENDIF
cdelete            ENDIF

            CALL EVALQ(CXADIA,CXAOFF,AKR,NAT03,E02,CXE,CXPOL,
     &                 CABS,CEXT,CPHA,MXN3,1)

            QABS(JO)=CABS/PIA2
            QEXT(JO)=CEXT/PIA2
            QPHA(JO)=CPHA/PIA2
            WRITE(IDVOUT,9010)QABS(JO),QEXT(JO)

C*** first call to timeit:

            CALL TIMEIT(' SCAT ',DTIME)

            IF(JO.EQ.1)THEN

               CALL SCAT(AKR,AKSR,DX,EM1R,EM2R,E02,ETASCA,CMDTRQ,
     &                CBKSCA,CSCA,CSCAG,CSCAG2,CTRQAB,CTRQSC,
     &                CXE,CXE01R,CXF11,CXF21,CXPOL,
     &                CXZW(1,1),CXZW(1,4),CXZW(1,7),CXZW(1,10),
     &                MXN3,MXNAT,MXSCA,NAT0,NAT03,NAVG,NSCAT,
     &                PHIN,SCRRS1,SCRRS2,THETAN,IXYZ0)

            ELSEIF(JO.EQ.2)THEN

               CALL SCAT(AKR,AKSR,DX,EM1R,EM2R,E02,ETASCA,CMDTRQ,
     &                CBKSCA,CSCA,CSCAG,CSCAG2,CTRQAB,CTRQSC,
     &                CXE,CXE01R,CXF12,CXF22,CXPOL,
     &                CXZW(1,1),CXZW(1,4),CXZW(1,7),CXZW(1,10),
     &                MXN3,MXNAT,MXSCA,NAT0,NAT03,NAVG,NSCAT,
     &                PHIN,SCRRS1,SCRRS2,THETAN,IXYZ0)

            ENDIF

C*** second call to timeit

            CALL TIMEIT(' SCAT ',DTIME)

            TIMERS(4)=DTIME
            QBKSCA(JO)=CBKSCA/PIA2
            QSCA(JO)=CSCA/PIA2

C*** Since Q_ext and Q_abs are calculated "exactly", when particles
C    are "large" we obtain Q_sca from (Q_ext-Q_abs) rather than
C    scattering cross section computed by SCAT.  This is particularly
C    advantageous when the particles are large with complex scattering
C    patterns, so that angular integration of the differential scattering
C    cross section would be either very time-consuming or inaccurate.
C    However, when particles are "small" the scattering cross section
C    is small compared to Q_ext and Q_abs, so that the difference
C    (Q_ext-Q_abs) may be inaccurate.  Accordingly, when particles
C    are "small" we instead accept the scattering cross section
C    computed by SCAT (probably quite accurate when albedo is small because
C    the scattering pattern tends to be dipolar and therefore well-resolved
C    by a reasonable number of scattering directions ICTHM and IPHI).
C    We use an ad-hoc procedure to smoothly make the transitions
C    between these regimes, based on the albedo.
C    The "dividing" line of albedo=.03 is chosen on basis of
C    numerical experiments.  If Q_ext and Q_abs are each calculated to
C    accuracy of 1 times 10^{-4} (say), then the
C    difference between Q_ext and Q_abs would be accurate to
C    0.0001*Q_ext*sqrt(2) .  When albedo=.03 (Q_ext-Q_abs)/Q_sca would
C    then be accurate to .0001*sqrt(2)/.03=.005

            FALB=(QSCA(JO)/(.03*QEXT(JO)))**2
            QSCA(JO)=(QSCA(JO)+(QEXT(JO)-QABS(JO))*FALB)/(1.+FALB)

C    Compute QSCAG(1-3,JO), QTRQSC(1-3,JO), QSCAG2

            DO I=1,3
               QSCAG(I,JO)=QSCA(JO)*CSCAG(I)/CSCA
            ENDDO
            QSCAG2(JO)=QSCA(JO)*CSCAG2/CSCA
            IF(CMDTRQ.EQ.'DOTORQ')THEN
               DO I=1,3
                  QTRQAB(I,JO)=CTRQAB(I)/PIA2
                  QTRQSC(I,JO)=CTRQSC(I)/PIA2
               ENDDO
            ENDIF

         ENDDO

      ELSEIF(IPHI.GE.2)THEN

C*** Have previously computed dipole polarization vectors for
C    first phi value (and reduced them to NAT03 elements).
C    Use these two solutions to obtain Qabs, Qext, Qpha, Qsca, g*Qsca,
C    and fml for any additional values of target rotation phi.
C    CXSCR1     contains polarization vector for IPHI=1 and JO=1
C    CXSC(LACE) contains polarization vector for IPHI=1 and JO=2
C
C Incident polarization state 1 = CXE01R
C Call EVALE to obtain E at NAT0 occupied lattice sites
C first call to timing routine
C

         CALL TIMEIT(' EVALE',DTIME)

C*** Call EVALE for NAT0 occupied sites

         CALL EVALE(CXE01R,AKR,DX,IXYZ0,MXNAT,MXN3,NAT0,NAT0,
     &              NX,NY,NZ,CXE)

C second call to timing routine

         CALL TIMEIT(' EVALE',DTIME)
         TIMERS(5)=DTIME

C Compute polarizabilities at NAT sites, then reduce to NAT0 occupied
C sites:

         CALL TIMEIT(' ALPHA',DTIME)
         CALL ALPHA(AKR,CALPHA,CXALDS,CXALPH,CXALOF,CXALOS,
     &        CXE01R,CXEPS,CXSC,CXSCR1,CXZC,CXZW,DX,IBETH,IBETH1,
     &        ICOMP,IOCC,IPHI,IPHI1,IXYZ0,1,MYID,MXCOMP,MXNAT,MXN3,
     &        NAT,NAT0,NAT3,NCOMP,NX,NY,NZ,CXRLOC,CSHAPE,SHPAR)
         CALL REDUCE(CXALPH,IOCC,MXN3,MXNAT,NAT,NAT0)
         CALL REDUCE(CXALOF,IOCC,MXN3,MXNAT,NAT,NAT0)
         CALL TIMEIT(' ALPHA',DTIME)
         TIMERS(6)=DTIME

C*** Construct polarization for incident pol. state 1

         COSPHI=COS(PHI(IPHI)-PHI(1))
         SINPHI=SIN(PHI(IPHI)-PHI(1))
         DO I=1,NAT03
            CXPOL(I)=COSPHI*CXSCR1(I)-SINPHI*CXSC(LACE+I-1)
         ENDDO

C*** first call to timing routine

         CALL TIMEIT(' EVALQ',DTIME)

         CALL EVALQ(CXADIA,CXAOFF,AKR,NAT03,E02,CXE,CXPOL,
     &              CABS,CEXT,CPHA,MXN3,1)

C*** second call to timing routine

         CALL TIMEIT(' EVALQ',DTIME)
         TIMERS(7)=DTIME

         QABS(1)=CABS/PIA2
         QEXT(1)=CEXT/PIA2
         QPHA(1)=CPHA/PIA2

C*** first call to timing routine

         CALL TIMEIT(' SCAT',DTIME)

C*** Now call SCAT
C    CXPOL has been reduced to NAT03 elements
C    first NAT03 elements of IXYZ0 correspond to physical sites

         CALL SCAT(AKR,AKSR,DX,EM1R,EM2R,E02,ETASCA,CMDTRQ,
     &             CBKSCA,CSCA,CSCAG,CSCAG2,CTRQAB,CTRQSC,
     &             CXE,CXE01R,CXF11,CXF21,CXPOL,
     &             CXZW(1,1),CXZW(1,4),CXZW(1,7),CXZW(1,10),
     &             MXN3,MXNAT,MXSCA,NAT0,NAT03,NAVG,NSCAT,
     &             PHIN,SCRRS1,SCRRS2,THETAN,IXYZ0)

C*** second call to timing routine

         CALL TIMEIT(' SCAT',DTIME)
         TIMERS(8)=DTIME

         QBKSCA(1)=CBKSCA/PIA2
         QSCA(1)=CSCA/PIA2

C*** As above, compute Q_sca from either SCAT or (Q_ext-Q_abs)
C    depending on whether albedo << .03 or albedo >> .03

         FALB=(QSCA(1)/(.03*QEXT(1)))**2
         QSCA(1)=(QSCA(1)+(QEXT(1)-QABS(1))*FALB)/(1.+FALB)
         DO I=1,3
            QSCAG(I,1)=QSCA(1)*CSCAG(I)/CSCA
            QTRQAB(I,1)=CTRQAB(I)/PIA2
            QTRQSC(I,1)=CTRQSC(I)/PIA2
         ENDDO
         QSCAG2(1)=QSCA(1)*CSCAG2/CSCA

C*** Polarization state 2:

C*** first call to timing routine

         CALL TIMEIT(' EVALE',DTIME)

C*** Call EVALE for NAT0 occupied sites
C    to obtain appropriate E vector for pol. state 2

         CALL EVALE(CXE02R,AKR,DX,IXYZ0,MXNAT,MXN3,NAT0,NAT0,
     &              NX,NY,NZ,CXE)

C*** second call to timing routine

         CALL TIMEIT(' EVALE',DTIME)
         TIMERS(9)=DTIME

C Compute polarizabilities at NAT sites, then reduce to NAT0 occupied
C sites:

         CALL TIMEIT(' ALPHA',DTIME)
         CALL ALPHA(AKR,CALPHA,CXALDS,CXALPH,CXALOF,CXALOS,
     &        CXE02R,CXEPS,CXSC,CXSCR1,CXZC,CXZW,DX,IBETH,IBETH1,
     &        ICOMP,IOCC,IPHI,IPHI1,IXYZ0,2,MYID,MXCOMP,MXNAT,MXN3,
     &        NAT,NAT0,NAT3,NCOMP,NX,NY,NZ,CXRLOC,CSHAPE,SHPAR)
         CALL REDUCE(CXALPH,IOCC,MXN3,MXNAT,NAT,NAT0)
         CALL REDUCE(CXALOF,IOCC,MXN3,MXNAT,NAT,NAT0)
         CALL TIMEIT(' ALPHA',DTIME)
         TIMERS(10)=DTIME

C*** Construct incident polarization vector for pol. state 2

         DO I=1,NAT03
            CXPOL(I)=COSPHI*CXSC(LACE+I-1)+SINPHI*CXSCR1(I)
         ENDDO

C*** first call to timing routine

         CALL TIMEIT(' EVALQ ',DTIME)
C
         CALL EVALQ(CXADIA,CXAOFF,AKR,NAT03,E02,CXE,CXPOL,
     &              CABS,CEXT,CPHA,MXN3,1)

C*** second call to timing routine

         CALL TIMEIT(' EVALQ ',DTIME)
         TIMERS(11)=DTIME
C
         QABS(2)=CABS/PIA2
         QEXT(2)=CEXT/PIA2
         QPHA(2)=CPHA/PIA2

C*** Call SCAT
C    CXPOL has NAT03 elements
C    IXYZ0 was initially given NAT03 elements

C*** first call to timing routine:

         CALL TIMEIT(' SCAT',DTIME)
         CALL SCAT(AKR,AKSR,DX,EM1R,EM2R,E02,ETASCA,CMDTRQ,
     &             CBKSCA,CSCA,CSCAG,CSCAG2,CTRQAB,CTRQSC,
     &             CXE,CXE01R,CXF12,CXF22,CXPOL,
     &             CXZW(1,1),CXZW(1,4),CXZW(1,7),CXZW(1,10),
     &             MXN3,MXNAT,MXSCA,NAT0,NAT03,NAVG,NSCAT,
     &             PHIN,SCRRS1,SCRRS2,THETAN,IXYZ0)

C*** second call to timing routine

         CALL TIMEIT(' SCAT',DTIME)
         TIMERS(12)=DTIME

         QBKSCA(2)=CBKSCA/PIA2
         QSCA(2)=CSCA/PIA2

C*** As above, compute Q_sca from either SCAT or (Q_ext-Q_abs)
C    depending on whether albedo << .03 or albedo >> .03

         FALB=(QSCA(2)/(.03*QEXT(2)))**2
         QSCA(2)=(QSCA(2)+(QEXT(2)-QABS(2))*FALB)/(1.+FALB)
         DO I=1,3
            QSCAG(I,2)=QSCA(2)*CSCAG(I)/CSCA
            QTRQAB(I,2)=CTRQAB(I)/PIA2
            QTRQSC(I,2)=CTRQSC(I)/PIA2
         ENDDO
         QSCAG2(2)=QSCA(2)*CSCAG2/CSCA

      ENDIF

C*** If IORTH=2, then we have results for two incident polarization
C    states CXE01R and CXE02R, and it is possible to compute f_{ml} for
C    standard definition of f_{ml} in terms of incident polarization
C    states 1 and 2 defined by the scattering plane.
C    If, however, computations were done for IORTH=1, then results
C    exist only for single incident polarization state CXE01R, and
C    it is not possible to construct results for incident polarization
C    states defined by the scattering plane.  In this case we therefore
C    use results for f_{m1}, where polarization state 1 = CXE01R.
C
c BTD 98.12.04 disable and keep "primitive" f_ml----------------------
c     IF(IORTH.EQ.2)THEN
C*** Values of CXF11, CXF12, CXF21, CXF22 are for incident polarization
C    states CXE01R and CXE02R.  Now convert to standard definition of
C    f_{ml}: incident pol states 1 and 2 defined by scattering plane
c         DO I=1,NSCAT
c            CXVAR1=CXF11(I)
c            CXVAR2=CXF21(I)
c            COSPHI=COS(PHIN(I))
c            SINPHI=SIN(PHIN(I))
c            CXF11(I)=COSPHI*CXVAR1+SINPHI*CXF12(I)
c            CXF21(I)=COSPHI*CXVAR2+SINPHI*CXF22(I)
c            CXF12(I)=COSPHI*CXF12(I)-SINPHI*CXVAR1
c            CXF22(I)=COSPHI*CXF22(I)-SINPHI*CXVAR2
c         ENDDO
c      ENDIF
c----------------------------------------------------------------------

      RETURN
 9010 FORMAT(1X,'Q_abs =',1PE10.3,' Q_ext= ',E10.3)
 9200 FORMAT(' final true frac.err=',F12.7)
      END
