      SUBROUTINE DIAGL(U,V,IPAR)
C cg package
C Left preconditioning subroutine - division by diagonal
C Arguments:
      COMPLEX U(*), V(*)
      INTEGER IPAR(*)
C
C Common variables:
      CHARACTER*6 CMETHD
      INTEGER
     &   IDVOUT,MXMEMF,MXN3F,MXNATF,MXNXF,MXNYF,MXNZF,
     &   NAT,NAT0,NAT3,NX,NY,NZ
      COMPLEX CXADIA(1)
C-----------------------------------------------------------------------
      COMMON /M2/ CXADIA
      COMMON /M6/ MXNATF, MXNXF, MXNYF, MXNZF, NAT, NAT3, NAT0, 
     $  NX, NY, NZ, MXMEMF, MXN3F, IDVOUT, CMETHD
C-----------------------------------------------------------------------
      CALL CDIV(U,V,CXADIA,NAT3)
      RETURN
      END
      SUBROUTINE CDIV(U,V,CXA,N)
C Arguments:
      INTEGER N
      COMPLEX U(*), V(*), CXA(*)
C
C Local variables:
      INTEGER I
C
C cg package 
C needed by left preconditioning subroutine
      DO 10 I=1,N
        V(I)=U(I)/CXA(I)
 10   CONTINUE
      RETURN
      END
      SUBROUTINE MATVEC(CXX, CXY, IPAR)
C Arguments:
      COMPLEX CXX(*), CXY(*), IPAR(*)
C Common:
      INTEGER*2 iocc(1)
      INTEGER
     &   IDVOUT,MXMEMF,MXN3F,MXNATF,MXNXF,MXNYF,MXNZF,
     &   NAT,NAT0,NAT3,NX,NY,NZ
      CHARACTER*6 CMETHD
      REAL AKR(3)
      COMPLEX CXADIA(1),CXZC(1), CXZW(1)
C-----------------------------------------------------------------------
      COMMON /M1/ AKR, /M2/ CXADIA, /M3/ CXZC, /M4/CXZW, /M5/ IOCC
      COMMON /M6/ MXNATF, MXNXF, MXNYF, MXNZF, NAT, NAT3, NAT0, 
     &  NX, NY, NZ, MXMEMF, MXN3F, IDVOUT, CMETHD
C-----------------------------------------------------------------------
C
C***********************************************************************
C matvec  --> cxy = A cxx         'N'
C tmatvec --> cxy = A' cxx        'T'
C cmatvec --> cxy = conjg(A') cxx  'C'
C 
C Notice that DDSCAT has cases 'N' and 'C' implemented in CPROD
C Notice, however, that in DDSCAT 'T'='N'.
C Some CG methods use cases N, C (like Petravic).
C Some CG methods use cases N, T (like PIM)
C Some CG use all three products N, C, T  (parts of CCGPAK)
C
C Information about matrix A is transfered via commons /m1/-/m6/ with
C the main program. Arrays cxadia, cxzc, cxzwm, iocc are properly
C dimensioned inside "cprod". You may get warning during the compilation
C about "misaligned common". Ignore these. Also notice mxnat-f,
C mxn3-f,mxnx-f, mxny-f, mxnz-f. These are defined by "parameter
C statement" in main code and this is the reason why they have "f" suffix.
C
C ipar - information array, not used, defined for compatibility
C***********************************************************************
      CALL CPROD(AKR,CMETHD,'N',CXADIA,
     &           CXX,CXY,CXZC,CXZW,
     &           IDVOUT,IOCC,MXN3f,MXNATf,MXNXf,MXNYf,MXNZf,
     &           NAT,NAT0,NAT3,NX,NY,NZ)
      RETURN
      END

      SUBROUTINE CMATVEC(CXX, CXY, IPAR)
C Arguments:
      COMPLEX CXX(*), CXY(*), IPAR(*)
C
C Common:
      INTEGER*2 iocc(1)
      INTEGER
     &   IDVOUT,MXMEMF,MXN3F,MXNATF,MXNXF,MXNYF,MXNZF,
     &   NAT,NAT0,NAT3,NX,NY,NZ
      CHARACTER*6 CMETHD
      REAL akr(3)
      COMPLEX CXADIA(1),CXZC(1), CXZW(1)
C-----------------------------------------------------------------------
      COMMON /M1/ AKR, /M2/ CXADIA, /M3/ CXZC, /M4/CXZW, /M5/ IOCC
      COMMON /M6/ MXNATF, MXNXF, MXNYF, MXNZF, NAT, NAT3, NAT0, 
     &  NX, NY, NZ, MXMEMF, MXN3F, IDVOUT, CMETHD
C-----------------------------------------------------------------------
C Local variables:
C***********************************************************************
C matvec  --> cxy = A cxx   
C tmatvec --> cxy = A' cxx   
C cmatvec --> cxy = conjg(A') cxx   
C***********************************************************************
      CALL CPROD(AKR,CMETHD,'C',CXADIA,
     &           CXX,CXY,CXZC,CXZW,
     &           IDVOUT,IOCC,MXN3f,MXNATf,MXNXf,MXNYf,MXNZf,
     &           NAT,NAT0,NAT3,NX,NY,NZ)
      RETURN
      END

      SUBROUTINE CPROD(AK,CMETHD,CWHAT,CXADIA,
     &                 CXX,CXY,CXZC,CXZW,
     &                 IDVOUT,IOCC,MXN3,MXNAT,MXNX,MXNY,MXNZ,
     &                 NAT,NAT0,NAT3,NX,NY,NZ)
C
C If CWHAT = 'N', this returns CXY(j)=A(j,k)*CXX(k) (sum over k)
C          = 'C', this returns CXY(j)=conjg(A(k,j))*CXX(k) (sum over k)
C
C It is assumed that matrix A(j,k) is symmetric
C Diagonal elements of A(j,k) are in vector ADIAG(j)
C Off-diagonal elements of A(j,k) are produced internally by
C   subroutine ESELF, which uses 3d-FFT to accomplish convolution
C   of CXX with A-matrix.
C
C Original version of CPROD created by P.J.Flatau, Colorado State Univ.
C Subsequently modified by B.T.Draine, Princeton Univ. Obs.
C History:
C 90/11/ 4 (BTD): Major modification to incorporate FFT method (FFT
C                 computations are handled by ESELF).
C 90/11/ 8 (BTD): Remove DO...ENDDO structures; renumber DO...CONTINUEs
C 90/11/21 (BTD): Remove "CCGMVM" option: only FFT stuff retained.
C 90/12/03 (BTD): No longer necessary to change ordering of CXX and CXY
C 90/12/05 (BTD): Changed call to ESELF to eliminate MXNX,MXNY,MXNZ
C
C Copyright (C) 1993, B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
C*** Arguments:
      INTEGER IDVOUT,MXN3,MXNAT,MXNX,MXNY,MXNZ,
     &        NAT,NAT0,NAT3,NX,NY,NZ
      CHARACTER CMETHD*6,CWHAT*1
      INTEGER*2 IOCC(MXNAT)
      REAL AK(3)
      COMPLEX CXADIA(MXN3),
     &        CXX(MXN3),CXY(MXN3),CXZC(NX+1,NY+1,NZ+1,6),
     &        CXZW(MXNX*MXNY*MXNZ,*)
C
C*** Local variables:
      INTEGER J
      REAL AKD
C
C Intrinsic functions:
      INTRINSIC CONJG
C
C***********************************************************************
      AKD=SQRT(AK(1)*AK(1)+AK(2)*AK(2)+AK(3)*AK(3))
C We assume that input vector CXX has zeroes for elements corresponding
C to vacuum sites.
      IF(CWHAT.EQ.'N')THEN
C**********************************************************************
C
          CALL ESELF(CMETHD,CXX,NX,NY,NZ,AKD,CXZC,CXZW,CXY)
C
C*************************************************************************
C ESELF omitted contribution from diagonal terms: add these.
C Also remember that ESELF computes -A_jk*x_k
          DO 160 J=1,NAT3
              CXY(J)=CXADIA(J)*CXX(J)-CXY(J)
  160     CONTINUE
C
C***
C
      ELSEIF(CWHAT.EQ.'C')THEN
C Need to temporarily replace CXX by conjg(CXX)
          DO 170 J=1,NAT3
              CXX(J)=CONJG(CXX(J))
  170     CONTINUE
C**********************************************************************
C
          CALL ESELF(CMETHD,CXX,NX,NY,NZ,AKD,CXZC,CXZW,CXY)
C
C************************************************************************
C
C ESELF omitted contribution from diagonal terms: add these.
C Also remember that ESELF computed -A_jk*conjg(x_k), while
C we seek to compute conjg(A_kj)* x_k.  Since A_kj=A_jk, we have
C conjg(A_kj)*x_k=conjg(A_jk*conjg(x_k))
          DO 230 J=1,NAT3
              CXY(J)=CXADIA(J)*CXX(J)-CXY(J)
              CXY(J)=CONJG(CXY(J))
  230     CONTINUE
C Restore CXX:
          DO 240 J=1,NAT3
              CXX(J)=CONJG(CXX(J))
  240     CONTINUE
      ELSE
          WRITE(IDVOUT,FMT=*)' Error in CPROD: CWHAT= ',CWHAT
      ENDIF
C
C*** Now must "clean" product vector CXY:
C    (zero out elements corresponding to vacuum sites)
C
      IF(NAT0.LT.NAT)CALL NULLER(CXY,IOCC,MXNAT,MXN3,NAT)
      RETURN
      END
