C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
SUBROUTINE KSTEP
> (KNV3,NBZTYP,ALTV,RLTV,NKX,NKY,NKZ,NKX2,NKY2,NKZ2,NFOUT,
< KV3,VX,VY,VZ,QWGT)
IMPLICIT LOGICAL(A-Z)
INTEGER KNV3,NBZTYP,NKX,NKY,NKZ,NKX2,NKY2,NKZ2,KV3
INTEGER INDX(0:20,0:20,0:20),IK,NFOUT
REAL ALTV(3,3),RLTV(3,3),A,B,C,PAI2,A1,B1,C1
REAL VX(KNV3),VY(KNV3),VZ(KNV3),QWGT(KNV3)
LOGICAL SPINP
PAI2 = 8.D0*ATAN(1.D0)
SPINP = .FALSE.
C*** IF((NBZTYP.EQ.0).OR.(NBZTYP.EQ.1)) THEN
IF((NBZTYP.EQ.0).OR.(NBZTYP.EQ.1).OR.(NBZTYP.EQ.9)
> .OR.(NBZTYP.GE.11)) THEN
IF(NBZTYP.EQ.0) THEN
C----------------------------------------------
WRITE(NFOUT,*) ' SURFACE B.Z. '
CALL KPMSF
> (KNV3,RLTV,NKX,NKY,NKZ,NKX2,NKY2,NKZ2,NFOUT,
< KV3,VX,VY,VZ)
C----------------------------------------------
C**** ELSE IF(NBZTYP.EQ.1) THEN
ELSE IF(NBZTYP.EQ.1.OR.NBZTYP.EQ.9.OR.NBZTYP.GE.11) THEN
C----------------------------------------------
WRITE(NFOUT,*) ' WHOLE B.Z. '
CALL KPMWBZ
> (KNV3,RLTV,NKX,NKY,NKZ,NKX2,NKY2,NKZ2,NFOUT,
< KV3,VX,VY,VZ)
C----------------------------------------------
END IF
DO 100 IK=1,KNV3
QWGT(IK) = 1.D0/DFLOAT(KV3)
100 CONTINUE
ELSE IF((NBZTYP.GE.2).AND.(NBZTYP.LE.5)) THEN
IF(NBZTYP.EQ.2) THEN
C----------------------------------------------------------
WRITE(NFOUT,*) ' SIMPLE CUBIC LATTICE '
CALL SCCM
> (KNV3,NKX,SPINP,NFOUT,
< KV3,VX,VY,VZ,QWGT,INDX)
C----------------------------------------------------------
ELSE IF(NBZTYP.EQ.3) THEN
C----------------------------------------------------------
WRITE(NFOUT,*) ' BCC LATTICE '
CALL BCCM
> (KNV3,NKX,SPINP,NFOUT,
< KV3,VX,VY,VZ,QWGT,INDX)
C----------------------------------------------------------
ELSE IF((NBZTYP.EQ.4).OR.(NBZTYP.EQ.5)) THEN
C----------------------------------------------------------
WRITE(NFOUT,*) ' FCC LATTICE '
CALL FCCM
> (KNV3,NKX,SPINP,NFOUT,
< KV3,VX,VY,VZ,QWGT,INDX)
C----------------------------------------------------------
END IF
A = ABS(ALTV(1,1)) * 2.D0
B = PAI2/A
DO 200 IK = 1,KV3
VX(IK) = B*VX(IK)
VY(IK) = B*VY(IK)
VZ(IK) = B*VZ(IK)
200 CONTINUE
ELSE IF(NBZTYP.EQ.6) THEN
C----------------------------------------------------------
WRITE(NFOUT,*) ' HEX LATTICE '
CALL HEXM
> (KNV3,NKX,NKY,RLTV,SPINP,NFOUT,
< KV3,VX,VY,VZ,QWGT,INDX)
C----------------------------------------------------------
ELSE IF (NBZTYP.EQ.8 .OR. NBZTYP.EQ.10) THEN
WRITE (NFOUT,*) ' TETRAGONAL LATTICE '
CALL TETRAH
> (KNV3,NKX,NKZ,RLTV,SPINP,NFOUT,
< KV3,VX,VY,VZ,QWGT,INDX)
A = ABS(ALTV(1,1))*2.0D0
A1 = PAI2/A
B = ABS(ALTV(3,3))*2.0D0
B1 = PAI2/B
WRITE (6,*) A,B,A1,B1,ALTV(1,1),ALTV(3,3)
DO 201 IK = 1,KV3
VX(IK) = A1*VX(IK)
VY(IK) = A1*VY(IK)
VZ(IK) = B1*VZ(IK)
201 CONTINUE
ELSE IF (NBZTYP.EQ.9.OR.NBZTYP.GE.11) THEN
WRITE (NFOUT,*) ' ORTHORHONBIC LATTICE '
CALL APBO2
> (KNV3,NKX,NKY,NKZ,RLTV,SPINP,NFOUT,
< KV3,VX,VY,VZ,QWGT,INDX)
A = ABS(ALTV(1,1))*2.0D0
A1 = PAI2/A
B = ABS(ALTV(2,2))*2.0D0
B1 = PAI2/B
C = ABS(ALTV(3,3))*2.0D0
C1 = PAI2/C
DO 202 IK = 1,KV3
VX(IK) = A1*VX(IK)
VY(IK) = B1*VY(IK)
VZ(IK) = C1*VZ(IK)
202 CONTINUE
ELSE
WRITE(NFOUT,*) ' NBZTYP ERR IN KSTEP NBUB = ',NBZTYP
STOP
END IF
C KV3=1
C A = ABS(ALTV(1,1))
C A1 = PAI2/A
C B = ABS(ALTV(3,3))
C B1 = PAI2/B
C WRITE (6,*) A,B,A1,B1,ALTV(1,1),ALTV(3,3)
C DO 202 IK = 1,KV3
C VX(IK) = A1*VX(IK)
C VY(IK) = A1*VY(IK)
C VZ(IK) = B1*VZ(IK)
C 202 CONTINUE
WRITE(NFOUT,300) (IK,VX(IK),VY(IK),VZ(IK),QWGT(IK),IK=1,KV3)
300 FORMAT((' ','IK = ',I3,3F10.6,3X,'QWGT = ',F10.6))
RETURN
END