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                   
          STOP                                                          
      END IF                                                            
      DO 7701 I=1,KSUM                                                  
        CHGB1(I)=0.0D0                                   
 7701 CONTINUE                                                          
C     VPP-PARALLEL START
C!XOCL PARALLEL REGION
!XOCL SPREAD DO /IP 
        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               
            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
      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                      
          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                                                            
C---------------------------------------------------------------        
      RETURN                                                            
      END