C------------------------------------------------------------
SUBROUTINE XCFFT(III,SCHGPC)
IMPLICIT REAL(A-H,O-Y)
IMPLICIT COMPLEX(Z)
INCLUDE 'PACVPP'
C-----ARRAYS FOR MFFT--------------------------------------------
DIMENSION IWL(8*IFX2+28),IWM(8*IFY2+28),IWN(8*IFZ2+28)
& ,IWORK(2*IFX2)
DIMENSION ZRB(IFX2,IFY2,IFZ2)
C============================================================
EQUIVALENCE (ZV1D(1),ZRB(1,1,1))
C============================================================
KFT1 = IFX2
KFT2 = IFY2
KFT3 = IFZ2
KSUM=KFT1*KFT2*KFT3
KVOL=(KFT1-1)*KFT2*KFT3
THIRD=1.D0/3.D0
ALFF=0.7D0
CO1=1.5D0*ALFF*(3.D0/PAI)**THIRD
CO2=(0.75D0/PAI)**THIRD
CO3=4.D0/3.D0
VCEL=ABS(UNIVOL/FLOAT(KVOL))
C*****---- SET UP C3FFT (FAST FOURIER TRANSFORMATION) -----
CALL C3FFT(ZRB,KFT1,KFT1-1,KFT2,KFT3,IWL,IWM,IWN
& ,0,0,1,IWORK,IERR)
IF (IERR.NE.0) THEN
WRITE (6,*) ' C3FFT(SET UP)] IERR = ',IERR
STOP
END IF
DO 111 I=1,KSUM
ZV1D(I)=DCMPLX(0.0D0,0.0D0)
111 CONTINUE
IF (III.EQ.3) THEN
DO 110 I=1,KG
L1=IGF1(I)
L2=IGF2(I)
L3=IGF3(I)
ZRB(L1,L2,L3)= ZRHPC(I)
110 CONTINUE
ELSE
DO 210 I=1,KG
L1=IGF1(I)
L2=IGF2(I)
L3=IGF3(I)
ZRB(L1,L2,L3)=ZCHG(I)+ZRHPC(I)
210 CONTINUE
END IF
C*****---- INVERSE FAST FOURIER TRANSFORMATION -----
CALL C3FFT(ZRB,KFT1,KFT1-1,KFT2,KFT3,IWL,IWM,IWN
& ,0,1,1,IWORK,IERRI)
IF (IERRI.NE.0) THEN
WRITE (6,*) ' C3FFT(INVERSE)] IERR = ',IERRI
STOP
END IF
DO 1000 I=1,KSUM
CHGB1(I) = DREAL(ZV1D(I))
1000 CONTINUE
DO 20 I=1,KSUM
IF( CHGB1(I).LE.0.0D0 ) THEN
IF ( MOD(I,IFX2).NE.0 ) THEN
C IF ( CHGB1(I).LE.-1.0D-5 ) THEN
C WRITE(6,610) I,CHGB1(I)
C 610 FORMAT(1H ,'**WARNING CHG.DEN<0.0 AT ',
C & I5,2D15.7,'***')
C END IF
CHGB1(I) = 1.D-40
ELSE
CHGB1(I) = 1.D-40
END IF
END IF
20 CONTINUE
S = 0.D0
DO 1010 I=1,KSUM
S = S+CHGB1(I)
1010 CONTINUE
S=S*VCEL - SCHGPC
IF (MOD(ITER,10).EQ.0) THEN
WRITE (6,*) 'REAL TOTAL CHARGE = ',S,' IN XCFFT'
END IF
C*****<<< WIGNER INTERPOLATION >>>
IF((III.EQ.1).OR.(III.EQ.3)) THEN
DO 1020 I=1,KSUM
RS=CO2*( 1.0D0/CHGB1(I) )**THIRD
RHO= -0.458D0*CO3/RS-(0.44D0*CO3*RS + 3.432D0)/
& (RS+7.8D0)**2
ZV1D(I)=DCMPLX(RHO,0.0D0)
1020 CONTINUE
ELSE
DO 1030 I=1,KSUM
RS=CO2*( 1.0D0/CHGB1(I) )**THIRD
RHO= -0.458D0/RS-0.44D0/(RS+7.8D0)
ZV1D(I)=DCMPLX(RHO,0.0D0)
1030 CONTINUE
END IF
C*****---- FAST FOURIER TRANSFORMATION -----
CALL C3FFT(ZRB,KFT1,KFT1-1,KFT2,KFT3,IWL,IWM,IWN
& ,0,-1,1,IWORK,IERR)
IF (IERR.NE.0) THEN
WRITE (6,*) ' C3FFT(FFT)] IERR = ',IERR
STOP
END IF
DENOM=1.0D0/DBLE(KVOL)
C----------------------------------------------------
IF (III.EQ.1) THEN
DO 120 I=1,KG
L1=IGF1(I)
L2=IGF2(I)
L3=IGF3(I)
ZVXC(I)=ZRB(L1,L2,L3)*DENOM
120 CONTINUE
ELSE IF (III.EQ.2) THEN
DO 121 I=1,KG
L1=IGF1(I)
L2=IGF2(I)
L3=IGF3(I)
ZEXC(I)=ZRB(L1,L2,L3)*DENOM
121 CONTINUE
ELSE IF (III.EQ.3) THEN
DO 122 I=1,KG
L1=IGF1(I)
L2=IGF2(I)
L3=IGF3(I)
ZVXCPC(I)=ZRB(L1,L2,L3)*DENOM
122 CONTINUE
END IF
RETURN
END