C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
SUBROUTINE CHAVER(IREC8,IREC9,KOPR,NOPR,KBZTYP)
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
IMPLICIT REAL(A-H,O-Y)
IMPLICIT COMPLEX(Z)
INCLUDE 'PACVPP'
C VPP-PARALLEL
!XOCL SUBPROCESSOR PS(IPARA)=PQ(1:IPARA)
!XOCL INDEX PARTITION IP=(PS,INDEX=1:KNV3,PART=BAND)
DIMENSION ZZZ(KNG1,KEG,KNV3),OCCUU(KEG,KNV3)
!XOCL LOCAL ZZZ(:,:,/IP),OCCUU(:,/IP)
EQUIVALENCE (ZAJ,ZZZ),(OCCUP,OCCUU)
C-----ARRAYS FOR MFFT--------------------------------------------
DIMENSION ZC3D1(IFX2,IFY2,IFZ2)
DIMENSION IWL(8*IFX2+28),IWM(8*IFY2+28),IWN(8*IFZ2+28)
& ,IWORK(2*IFX2)
C================================================================
EQUIVALENCE (ZC1D(1),ZC3D1(1,1,1))
C================================================================
C REWIND 90
KFT1 = IFX2
KFT2 = IFY2
KFT3 = IFZ2
KSUM=KFT1*KFT2*KFT3
KVOL=(KFT1-1)*KFT2*KFT3
CCC = 2.D0*RVOL/(2.D0*PAI)**3/FLOAT(KV3)
KIMG=1
C*****---- SET UP C3FFT (FAST FOURIER TRANSFORMATION) -----
CALL C3FFT(ZC3D1,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
cGEN STOP
END IF
DO 7701 I=1,KSUM
CHGB1(I) =0.0D0
CHGSUM(I)=0.0D0
7701 CONTINUE
C VPP-PARALLEL START
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP
*pdir pardo
DO 7820 IK=1,KV3
DO 7810 IBAN=NBD1,NBD2
C******* BUILD UP CHARGE DENSITY FOR IBAN-TH BAND, IK-TH K-POINT
C*********NAC = (IBAN-1)*KV3 + IWRT(IK)
C IF (IREC8.NE.0) NAC=IREC8*NAC-IREC8+1
C*********READ(80,REC=NAC) ZV1
IIBA=IBA(IK)
DO 7830 I=1,KSUM
ZC1D(I)=DCMPLX(0.0D0,0.0D0)
7830 CONTINUE
DO 232 I=1,IIBA
I1=NBASE(I,IK)
L1=IGF1(I1)
L2=IGF2(I1)
L3=IGF3(I1)
ZC3D1(L1,L2,L3) = ZZZ(I,IBAN,IK)
C***********ZC3D1(L1,L2,L3) = ZV1(I)
232 CONTINUE
C*****---- INVERSE FAST FOURIER TRANSFORMATION -----
CALL C3FFT(ZC3D1,KFT1,KFT1-1,KFT2,KFT3,IWL,IWM,IWN
& ,0,1,1,IWORK,IERR1)
IF (IERR1.NE.0) THEN
WRITE (6,*) ' C3FFT(IFFT C)] IERR1 = ',IERR1
cGEN STOP
END IF
C---------IREC = KV3*(IBAN-1)+IWRT(IK)
C IF (IREC.LE.IRECMX) THEN
C IF (IREC9.NE.0) IREC=IREC9*IREC-IREC9+1
C WRITE(90,REC=IREC) ZC1D
C---------END IF
DO 240 I=1,KSUM
CHGB1(I)=CHGB1(I)+OCCUU(IBAN,IK)*
& DCONJG(ZC1D(I))*ZC1D(I)
240 CONTINUE
7810 CONTINUE
7820 CONTINUE
!XOCL END SPREAD SUM(CHGB1)
C!XOCL END PARALLEL
cGEN
DO 7911 I=1,KSUM
*pdir critical
CHGSUM(I) = CHGSUM(I) + CHGB1(I)
*pdir endcritical
7911 CONTINUE
DO 7921 I=1,KSUM
CHGB1(I) CHGSUM(I)
7921 CONTINUE
cGEN
*pdir serial
DO 7900 I=1,KSUM
ZC1D(I)=CCC*CHGB1(I)
7900 CONTINUE
C*****---- FAST FOURIER TRANSFORMATION -----
CALL C3FFT(ZC3D1,KFT1,KFT1-1,KFT2,KFT3,IWL,IWM,IWN
& ,0,-1,1,IWORK,IERR)
IF (IERR.NE.0) THEN
WRITE (6,*) ' C3FFT(FFT)] IERR = ',IERR
cGEN STOP
END IF
DENOM=1.0D0/DBLE(KVOL)
DO 30 I=1,KG
L1=IGF1(I)
L2=IGF2(I)
L3=IGF3(I)
ZCHG(I)=ZC3D1(L1,L2,L3)*DENOM
30 CONTINUE
C---------------KNGP ---> KNG KPO ---> KOPR -----------------------
IF (KBZTYP.GE.2) THEN
CALL CHGAVR(KOPR,NOPR,KIMG)
END IF
*pdir endserial
cGEN
C---------------------------------------------------------------
RETURN
END