est_NTK.f90

Go to the documentation of this file.
00001 subroutine est_nkbi(N,SK,nkb1,nkb2,nkb3)  
00002 implicit none 
00003 integer::N,nkb1,nkb2,nkb3,NTK  
00004 real(8)::SK(3,N) 
00005 integer::i 
00006 real(8)::x 
00007 !---
00008 x=1.0d0 
00009 do i=1,N
00010  if(abs(SK(1,i))<1.0d-7) cycle 
00011  if(abs(SK(1,i))<x) then 
00012   x=abs(SK(1,i))  
00013  endif 
00014 enddo    
00015 nkb1=nint(1.0d0/x)  
00016 !---
00017 x=1.0d0 
00018 do i=1,N
00019  if(abs(SK(2,i))<1.0d-7) cycle 
00020  if(abs(SK(2,i))<x) then 
00021   x=abs(SK(2,i))  
00022  endif 
00023 enddo    
00024 nkb2=nint(1.0d0/x)  
00025 !---
00026 x=1.0d0 
00027 do i=1,N
00028  if(abs(SK(3,i))<1.0d-7) cycle 
00029  if(abs(SK(3,i))<x) then 
00030   x=abs(SK(3,i))  
00031  endif 
00032 enddo    
00033 nkb3=nint(1.0d0/x)  
00034 !---
00035 NTK=nkb1*nkb2*nkb3 
00036 !write(6,'(a24,4i10)') 'nkb1,nkb2,nkb3,NTK=',nkb1,nkb2,nkb3,NTK  
00037 !---
00038 return 
00039 end 
00040 !--
00041 !20180301 
00042 subroutine est_NTK(Nk_irr,Nsymq,SKI,rg,NTK)
00043 implicit none 
00044 integer::Nk_irr,Nsymq,N  
00045 real(8)::SKI(3,Nk_irr) 
00046 integer::rg(3,3,Nsymq) 
00047 real(8),allocatable::SK0(:,:)!SK0(3,N) 
00048 real(8)::ktmp(3)
00049 integer::RWtmp(3)
00050 integer::jk,ik,iop,iik 
00051 integer::NTK 
00052 !---
00053 N=Nk_irr*Nsymq*2
00054 !write(6,*)'N=',N
00055 !--
00056 !SK0,numirr,numrot,trs,RW
00057 allocate(SK0(3,N));SK0(:,:)=0.0d0
00058 !allocate(numirr(NTK));numirr(:)=0
00059 !allocate(numrot(NTK));numrot(:)=0
00060 !allocate(trs(NTK));trs(:)=0
00061 !allocate(RW(3,NTK));RW(:,:)=0
00062 jk=0
00063 do ik=1,Nk_irr
00064  do iop=1,Nsymq
00065   ktmp(:)=0.0d0; RWtmp(:)=0  
00066   ktmp(1)=dble(rg(1,1,iop))*SKI(1,ik)+dble(rg(1,2,iop))*SKI(2,ik)+dble(rg(1,3,iop))*SKI(3,ik)
00067   ktmp(2)=dble(rg(2,1,iop))*SKI(1,ik)+dble(rg(2,2,iop))*SKI(2,ik)+dble(rg(2,3,iop))*SKI(3,ik)
00068   ktmp(3)=dble(rg(3,1,iop))*SKI(1,ik)+dble(rg(3,2,iop))*SKI(2,ik)+dble(rg(3,3,iop))*SKI(3,ik)
00069   call kcheck(ktmp(1),RWtmp(1))!rewind check 
00070   do iik=1,jk
00071    if(abs(SK0(1,iik)-ktmp(1))<1.0d-4.and.abs(SK0(2,iik)-ktmp(2))<1.0d-4.and.abs(SK0(3,iik)-ktmp(3))<1.0d-4) goto 1000
00072   enddo!iik
00073   jk=jk+1
00074   SK0(:,jk)=ktmp(:)
00075   !numirr(jk)=ik;numrot(jk)=iop;trs(jk)=1;RW(:,jk)=RWtmp(:)
00076 1000 ktmp(:)=0.0d0; RWtmp(:)=0  
00077   ktmp(1)=dble(rg(1,1,iop))*SKI(1,ik)+dble(rg(1,2,iop))*SKI(2,ik)+dble(rg(1,3,iop))*SKI(3,ik)
00078   ktmp(2)=dble(rg(2,1,iop))*SKI(1,ik)+dble(rg(2,2,iop))*SKI(2,ik)+dble(rg(2,3,iop))*SKI(3,ik)
00079   ktmp(3)=dble(rg(3,1,iop))*SKI(1,ik)+dble(rg(3,2,iop))*SKI(2,ik)+dble(rg(3,3,iop))*SKI(3,ik)
00080   call kcheck_trs(ktmp(1),RWtmp(1))!rewind check modified 20170316  
00081   do iik=1,jk
00082    if(abs(SK0(1,iik)-(-ktmp(1)))<1.0d-4.and.abs(SK0(2,iik)-(-ktmp(2)))<1.0d-4.and.abs(SK0(3,iik)-(-ktmp(3)))<1.0d-4) goto 2000
00083   enddo!iik
00084   jk=jk+1
00085   SK0(:,jk)=-ktmp(:) 
00086   !numirr(jk)=ik;numrot(jk)=iop;trs(jk)=-1;RW(:,jk)=RWtmp(:) 
00087 2000 enddo!iop 
00088 enddo!ik 
00089 !--
00090 NTK=jk 
00091 if(NTK>N)then 
00092  write(6,*)'Estimated NTK is too large; stop' 
00093  write(6,*)'NTK, N=',NTK, N 
00094  stop
00095 endif 
00096 !write(6,*)'Estimated NTK=',NTK 
00097 return
00098 end