C SUBROUTINE ZZZY41 ====*====3====*====4====*====5====*====6====*====7
C WAVE VECTORS OF KB(3)/IC+G ARE GENERATED IN KM(,)
C A() HAS A LENGTH OF WAVE VECTOR
C KT() HAS A NUMBER WHICH INDICATES CHANGE POINT OF THE LENGTH
C IN THE TABLE OF KM(,)
C IK :NUMBER OF WAVE VECTOR IN KM(,)
C IE :NUMBER OF SHELL
C
C BUG FIXED BY A.YANASE (1998/01/26)
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
C
SUBROUTINE ZZZY41(KKB,ICC,AM)
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMPLEX*16 U
INCLUDE 'PARAM'
C PARAMETER(MAXNPW=4854)
COMMON/SPW/KM(4,MAXNPW),A(MAXNPW),U(MAXNPW),KT(MAXNPW),IE,IK
COMMON/LAT/AA,B,C,CA,CB,CC,A1,B1,C1
COMMON/SPG2/IL,NG,IG(48),JV(2,3,48)
SAVE /SPW/,/LAT/,/SPG2/
DIMENSION KB(3),KKB(3),KBB(3,10),IRECP(3,10)
CALL CHKDNM(ICC)
CALL NEAREC(KKB,ICC,KBB,IRECP,NG)
KB(1)=KBB(1,1)
KB(2)=KBB(2,1)
KB(3)=KBB(3,1)
IC=ICC
KXM=AM+4.5
KYM=AM*(A1/B1)*(B/AA)+4.5
KZM=AM*(A1/C1)*(C/AA)+4.5
IK=1
KM(1,1)=KB(1)
KM(2,1)=KB(2)
KM(3,1)=KB(3)
CALL ZZZY37(KB(1),KB(2),KB(3),IC,S)
A(1)=S
DO 41 IX=1,KXM
KX=(IX-1)*IC
DO 42 I1=1,2
DO 43 IY=1,KYM
KY=(IY-1)*IC
DO 44 I2=1,2
DO 45 IZ=1,KZM
IF(IX*IY*IZ.EQ.1) GO TO 45
KZ=(IZ-1)*IC
DO 46 I3=1,2
IF(IL.EQ.0) GO TO 460
IF(IL.EQ.1) GO TO 460
IF(IL.EQ.2) GO TO 462
IF(IL.EQ.3) GO TO 463
IF(IL.EQ.-1) GO TO 461
IF(MOD(IABS(KX+KY),2*IC).NE.0) GO TO 47
GO TO 460
461 KSUM=-KX+KY+KZ
IF(MOD(IABS(KSUM),3*IC).NE.0) GO TO 47
GO TO 460
463 IF(MOD(IABS(KX+KY+KZ),2*IC).NE.0) GO TO 47
GO TO 460
462 IF(MOD(IABS(KX),2*IC).NE.MOD(IABS(KY),2*IC)) GO TO 47
IF(MOD(IABS(KY),2*IC).NE.MOD(IABS(KZ),2*IC)) GO TO 47
460 CONTINUE
K1=KX+KB(1)
K2=KY+KB(2)
K3=KZ+KB(3)
CALL ZZZY37(K1,K2,K3,IC,W)
IF(W.GT.AM) GO TO 47
DO 48 JK=1,IK
JJK=IK-JK+1
IF(A(JJK).LT.W) GO TO 49
DO 50 I=1,3
50 KM(I,JJK+1)=KM(I,JJK)
A(JJK+1)=A(JJK)
48 CONTINUE
JJK=0
49 KM(1,JJK+1)=K1
KM(2,JJK+1)=K2
KM(3,JJK+1)=K3
A(JJK+1)=W
IK=IK+1
IF(IK.GT.MAXNPW) GO TO 53
47 IF(KZ.EQ.0) GO TO 45
KZ=-KZ
46 CONTINUE
45 CONTINUE
IF(KY.EQ.0) GO TO 43
KY=-KY
44 CONTINUE
43 CONTINUE
IF(KX.EQ.0) GO TO 41
KX=-KX
42 CONTINUE
41 CONTINUE
C DO 51 II=1,IK
C WRITE(6,601) II, (KM(K,II),K=1,3),IC,A(II)
C 601 FORMAT(I5,2H (,3I4,2H)/,I3,F10.5)
C 51 CONTINUE
IE=1
W=A(1)
KM(4,1)=0
DO 52 II=2,IK
KM(4,II)=0
IF(ABS(A(II)-W).LT.1.0D-4) GO TO 52
KT(IE)=II-1
IE=IE+1
W=A(II)
52 CONTINUE
KT(IE)=IK
RETURN
53 WRITE(6,660)
660 FORMAT(' STOP AT 53 IN ZZZY41 AM IS TOO LARGE')
STOP
END