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