PROGRAM ksymm C------------------------------------------------ C This program reads apw12.dat and produces C the sym.dat, used as an input to the TB program C for the symmetry points C It takes care of the number of eigen C values needed when diagonalizing the block C matrices. C------------------------------------------------ C Author : Brahim Akdim July 27/96 C------------------------------------------------ implicit double precision (a-h,o-z) parameter ( n=1500 ) dimension x(n),y(n),z(n),eigen(n),energy(n) dimension ix(n),iy(n),iz(n) dimension e(15),eh(100) dimension icode(n),num_eig(n),jjcode(n),num(n) character llabel(n)*6,label(n)*6,lab*6 open (1,file='apw12.dat') open (4,file='sym.dat') open (7,file='heigheg.dat') C---------------------------------------------------- ieh=1 7 format(F8.5) 14 continue read(7,7,end=77) eh(ieh) ieh = ieh + 1 go to 14 77 continue ieh = ieh -1 C----------------------------------------------------- i=1 write(*,*)'Lattice type :' read*,lattice 10 continue read(1,1,end=20)icode(i),num_eig(i), $ x(i),y(i),z(i),eigen(i),label(i) i=i+1 go to 10 20 continue 1 format(2I2,1X,3F5.1,F10.5,5X,A6) C--------------------------------------------------- C icount is the dimension of the file C--------------------------------------------------- icount = i - 1 jcode = 1 num_code = 0 ifirst = 0 ii = 0 new_k = 0 C-------------------------------------------------- do 100 j = 1,icount-1 if ( ( icode(j) .eq. icode(j+1) ) .and. & ( x(j) .eq. x(j+1) ) .and. & ( y(j) .eq. y(j+1) ) .and. & ( z(j) .eq. z(j+1) ) ) then C-------------------------------------------------- C jcode is the number of similar codes within C a given k point C-------------------------------------------------- jcode = jcode + 1 else C-------------------------------------------------- C num_code is the number of symmtery kind C within a given k_point C-------------------------------------------------- num_code = num_code + 1 C-------------------------------------------------- write(2,2)icode(j),jcode, & (eigen(kk),kk=j-jcode+1,j) C-------------------------------------------------- if ( & (x(j) .ne. x(j+1)) .or. & (y(j) .ne. y(j+1)) .or. & (z(j) .ne. z(j+1)) & ) then ii = ii + 1 num(ii) = num_code llabel(ii) = label(j) ix(ii) = int(x(j)) iy(ii) = int(y(j)) iz(ii) = int(z(j)) C write(2,3)num_code,label(j) new_k = new_k + 1 num_code = 0 endif jcode = 1 endif 100 continue rewind(2) print*,new_k print*,'You should get 96 for nacl ' print*,'otherwise check your apw12.dat' icheck = 0 do kkk = 1, new_k write(4,3)num(kkk),llabel(kkk),ix(kkk) & ,iy(kkk),iz(kkk) C----------------------------------------------------------- icheck = icheck+1 ntemp = num(kkk) C num_check = 0 do ikk = 1,num(kkk) C num_check = num_check + 1 nn3 = 0 read (2,2)kcode,nneig,(e(ll),ll=1,nneig) call numeig(kcode,nneig1,lattice) nneig2 = min(nneig1,nneig) do jch = 1,nneig2 if ( e(jch) .gt. eh(icheck) ) then print*,'find one' nn3 = nn3 + 1 endif enddo nneig2 = nneig2 - nn3 C if(nneig2 .eq. 0)ntemp=ntemp-1 if(nneig2 .ne. 0 )then write(4,21)kcode,nneig2,(e(ll),1,ll=1,nneig2) endif enddo C----------------------------------------------------------- enddo 2 format(5x,2i2,13F10.5 ) 21 format(5x,2i2,13(F10.5,I3)) 3 format(i2,5x,A5,5x,'submatrices',3x,'[',3I2,1x,']') end subroutine numeig(nsytyp,ns,lattice) integer nsytyp, ns C lattice = 4 print*,lattice if(lattice.eq.5) then c NaCl Lattice if(nsytyp.eq.1) then C GAMMA12,DELTA2,X2 NS=1 else if(nsytyp.eq.2) then C DELTA2P,X3,GAMMA25P NS=1 else if(nsytyp.eq.3) then C SIGMA2 (044) NS=1 else if(nsytyp.eq.4) then C X1 NS=3 else if(nsytyp.eq.5) then C DELTA 5 NS=3 else if(nsytyp.eq.6) then C Z4 NS=3 else if(nsytyp.eq.7) then C SIGMA3 (044) NS=3 else if(nsytyp.eq.8) then C X5P,GAMMA15 NS=2 else if(nsytyp.eq.9) then C X5 NS=1 else if(nsytyp.eq.10) then C X4P NS=2 else if(nsytyp.eq.11) then C LAMDA1 NS=5 else if(nsytyp.eq.12) then C DELTA 1(002) NS=5 else if(nsytyp.eq.13) then C LAMDA3 NS=4 else if(nsytyp.eq.14) then C W2P (480) NS=3 else if(nsytyp.eq.15) then C SIGMA4 (440) NS=3 else if(nsytyp.eq.16) then C W3 (048) NS=3 else if(nsytyp.eq.17) then C SIGMA1 (440) NS=6 else if(nsytyp.eq.18) then C Z2,W1P(048) NS=1 else if(nsytyp.eq.19) then C GAMMA 1 NS=2 else if(nsytyp.eq.20) then C L2P NS=2 else if(nsytyp.eq.21) then C L3 NS=3 else if(nsytyp.eq.22) then C L1 NS=3 else if(nsytyp.eq.23) then C Z3 NS=3 else if(nsytyp.eq.24) then C Z1(820) NS=6 else if(nsytyp.eq.25) then C Q1(264) NS=7 else if(nsytyp.eq.26) then C Q2(264) NS=6 else if(nsytyp.eq.27) then C W1 NS=3 else if(nsytyp.eq.28) then C (042),(062),(064) EVEN NS=9 else if(nsytyp.eq.29) then C (042),(062),(064) ODD NS=4 else if(nsytyp.eq.30) then C (224),(226),(442) EVEN NS=9 else if(nsytyp.eq.31) then C (224),(226),(442) ODD NS=4 else if(nsytyp.eq.32) then c L3P NS=1 C---------- endif over number symmetry type------ endif C---------- endif over lattice type 5 ------------ endif if(lattice.eq.4) then print*,'CsCl Structure' c ( CsCl Structure ) c if(nsytyp.eq.1) then c c Gamma 1 c ns=2 else if(nsytyp.eq.2) then c c Gamma 12, Delta 2 c ns=2 else if(nsytyp.eq.3) then c c Gamma 25', Delta 2' c ns=2 else if (nsytyp.eq.4) then c c Gamma 15 c ns=2 else if (nsytyp.eq.5) then c c Delta 5 c ns=4 else if (nsytyp.eq.6) then c c M5 c ns=2 else if (nsytyp.eq.7) then C SIGMA 3 ns = 4 else if (nsytyp.eq.8) then c c Lamda 1 c ns=6 c else if (nsytyp.eq.9) then c c R15 c ns=2 else if (nsytyp.eq.10) then C DELTA 1 ns=6 else if (nsytyp.eq.11) then C T1 ns=4 else if (nsytyp.eq.12) then c c Lamda 3 c ns=6 else if (nsytyp.eq.13) then C LAMDA 3 ns=6 else if (nsytyp.eq.14) then C SIGMA 1 ns=8 else if (nsytyp.eq.15) then c c M2p (N3p) and possibly M4p? c ns=2 else if (nsytyp.eq.16) then c c M5' (N4') c ns=2 else if (nsytyp.eq.17) then c c M1 c ns=3 else if (nsytyp.eq.18) then c c T5 (D4) c ns=4 else if (nsytyp.eq.19) then c c S1 c ns=8 else if (nsytyp.eq.20) then c c S2 c ns=2 else if (nsytyp.eq.21) then c c S3 c ns=4 else if (nsytyp.eq.22) then c c S4 c ns=4 else if (nsytyp.eq.23) then C Z1 ns = 6 else if (nsytyp.eq.24) then c c R25' c ns=2 else if (nsytyp.eq.25) then c c X4' c ns=3 else if (nsytyp.eq.26) then c c X1 c ns=3 else if (nsytyp.eq.27) then c c M3 c ns=3 else if (nsytyp.eq.28) then C Z3 ns=6 else if (nsytyp.eq.29) then C Z2 ns=3 else if (nsytyp.eq.30) then C Z4 ns=3 else if (nsytyp.eq.31) then c c R12, M2, T2, X2 c ns=1 else if (nsytyp.eq.32) then C R12',M4,T1',X3' ns=1 else if (nsytyp.eq.33) then c c X3 c ns=1 else if (nsytyp.eq.34) then C X2' ns=1 else if (nsytyp.eq.35) then c c X5' c ns=2 else if (nsytyp.eq.36) then c c X5 c ns=2 else if (nsytyp.eq.39) then C T2' ns=4 else if (nsytyp.eq.42) then c c R1 c ns=1 else if (nsytyp.eq.43) then C R2' ns=1 end if C---------- endif over lattice type 4 ------------ endif return end