C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^          
      SUBROUTINE BASNUM(QWGT) 
C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^          
      IMPLICIT REAL(A-H,O-Y)                                          
      IMPLICIT COMPLEX(Z)                                            
      INCLUDE 'PACVPP' 
      DIMENSION QWGT(KNV3) 
C     //////////////////////////////                                    
C     // CUT OFF FOR WAVEFUNCTION //                                    
C     //////////////////////////////                                    
      JGB=0                                                             
      JG2=0                                                             
      JJT=0                                                             
      GRVT=0.D0                                                         
      DO 1000 I=1,KV3
                      DX = VX(I)                                        
                      DY = VY(I)                                        
                      DZ = VZ(I)                                        
                      JJ = 0                                            
                      KK = 0                                            
                      GRVMX =  0.D0                                     
      DO 1100 J=1,KG
        GRVV = SQRT((DX+GX(J))**2+(DY+GY(J))**2+(DZ+GZ(J))**2)          
        IF(GRVV.LE.GMAX) THEN                                           
            JJ = JJ + 1                                                 
            NBASE(JJ,I)=J                                               
            IF(GRVMX.LT.GRVV) GRVMX = GRVV                              
        END IF                                                          
        IF(GRVV.LE.GMAX/2.0D0) THEN                                     
         KK = KK + 1                                                    
         NBMAT(KK,I)=J                                                  
        END IF                                                          
 1100 CONTINUE 
      IBA(I) = JJ                                                       
      JJT    = JJT+JJ                                                   
      GRVT   = GRVT+GRVMX*QWGT(I)                                       
      IBA2(I)= KK                                                       
      WRITE(6,1200) I,JJ,KK,GRVT                                        
 1200 FORMAT(' ',' K = ',I4,' JJ = ',I5,' KK = ',I5,' GRV = ',F12.8)    
      IF(JJ.GT.JGB) JGB = JJ                                            
      IF(KK.GT.JG2) JG2 = KK                                            
 1000 CONTINUE 
      WRITE(6,*) 'MAXIMUM NUMBER OF BASES FOR WAVE FUNCTION (KG1)=',JGB 
      WRITE(6,*) ' JJT = ',JJT,' MEAN GRV = ',GRVT                      
      WRITE(6,*) 'MAXIMUM NUMBER OF BASES FOR (GMAX/2)      (KG2)=',JG2 
C     <----- ATTN] KG1 WO SAITEIGI SHITE IRU]                           
      KG1=JGB                                                           
      NBMX = 0                                                          
      DO 2000 IK = 1,KV3
        IIBA = IBA(IK)                                                  
        DO 2010 I= 1,IIBA                                               
          NBMX=MAX(NBASE(I,IK),NBMX)                                    
 2010   CONTINUE                                                        
 2000 CONTINUE 
      WRITE(6,2020) NBMX                                                
 2020 FORMAT(' ','MAX NBMX  = ',I6)                                     
      RETURN                                                            
      END