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