calc_ksdos.f90

Go to the documentation of this file.
00001 subroutine calc_ksdos(NWF,NTK,nsgm,Na1,Na2,Na3,nkb1,nkb2,nkb3,idlt,dmna,dmnr,FermiEnergy,a1,a2,a3,b1,b2,b3,sgmw,SK0,KS_R,ksdos)
00002   !
00003   implicit none 
00004   integer::NWF,NTK,nsgm,Na1,Na2,Na3,nkb1,nkb2,nkb3 
00005   real(8)::idlt,dmna,dmnr
00006   real(8)::a1(3),a2(3),a3(3)
00007   real(8)::b1(3),b2(3),b3(3)
00008   real(8)::sgmw(nsgm)  
00009   real(8)::SK0(3,NTK) 
00010   complex(8)::KS_R(NWF,NWF,-Na1:Na1,-Na2:Na2,-Na3:Na3)   
00011   !
00012   real(8),allocatable::WEIGHT_R(:,:,:)!WEIGHT_R(-Na1:Na1,-Na2:Na2,-Na3:Na3)
00013   real(8),allocatable::EKS(:,:)!EKS(NWF,NTK)           
00014   complex(8),allocatable::VKS(:,:,:)!VKS(NWF,NWF,NTK)   
00015   complex(8),allocatable::pf(:,:,:,:)!pf(-Na1:Na1,-Na2:Na2,-Na3:Na3,NTK)   
00016   ! 
00017   integer::ia1min,ia2min,ia3min 
00018   integer::ia1,ia2,ia3,ik,ib,jb,ie  
00019   real(8)::PHASE,FermiEnergy 
00020   real(8)::SUM_REAL
00021   complex(8)::SUM_CMPX 
00022   !
00023   real(8),parameter::au=27.21151d0
00024   real(8),parameter::tpi=2.0d0*dacos(-1.0d0)
00025   complex(8),parameter::ci=(0.0D0,1.0D0) 
00026   !
00027   real(8),intent(out)::ksdos(nsgm) 
00028   !
00029   !1. WEIGHT_R BY Y.Nomura NOMURA 
00030   !
00031   allocate(WEIGHT_R(-Na1:Na1,-Na2:Na2,-Na3:Na3)); WEIGHT_R=1.0d0
00032   SUM_REAL=0.0d0 
00033   do ia1=-Na1,Na1
00034    do ia2=-Na2,Na2
00035     do ia3=-Na3,Na3
00036      if(abs(ia1)==Na1.and.mod(nkb1,2)==0.and.Na1/=0) WEIGHT_R(ia1,ia2,ia3)=WEIGHT_R(ia1,ia2,ia3)*0.5d0 
00037      if(abs(ia2)==Na2.and.mod(nkb2,2)==0.and.Na2/=0) WEIGHT_R(ia1,ia2,ia3)=WEIGHT_R(ia1,ia2,ia3)*0.5d0 
00038      if(abs(ia3)==Na3.and.mod(nkb3,2)==0.and.Na3/=0) WEIGHT_R(ia1,ia2,ia3)=WEIGHT_R(ia1,ia2,ia3)*0.5d0 
00039      SUM_REAL=SUM_REAL+WEIGHT_R(ia1,ia2,ia3)
00040     enddo!ia3
00041    enddo!ia2
00042   enddo!ia1
00043   write(6,'(a20,f15.8,i8)')'SUM_WEIGHT,NTK',SUM_REAL,NTK  
00044   if(abs(SUM_REAL-dble(NTK))>1.0d-6)then 
00045    stop 'SUM_WEIGHT/=NTK'
00046   endif 
00047   !
00048   allocate(pf(-Na1:Na1,-Na2:Na2,-Na3:Na3,NTK)); pf=0.0d0 
00049   do ik=1,NTK 
00050    do ia3=-Na3,Na3 
00051     do ia2=-Na2,Na2 
00052      do ia1=-Na1,Na1 
00053       !
00054       !NEAREST R SEARCH BY Y.Yoshimoto 
00055       !
00056       call search_Rmin(ia1,ia2,ia3,nkb1,nkb2,nkb3,a1(1),a2(1),a3(1),ia1min,ia2min,ia3min)
00057       PHASE=tpi*(SK0(1,ik)*DBLE(ia1min)+SK0(2,ik)*DBLE(ia2min)+SK0(3,ik)*DBLE(ia3min))           
00058       pf(ia1,ia2,ia3,ik)=EXP(ci*PHASE)*WEIGHT_R(ia1,ia2,ia3)          
00059      enddo!ia1 
00060     enddo!ia2 
00061    enddo!ia3 
00062   enddo!ik  
00063   write(6,*)'# finish make pf'
00064   !
00065   !2. HKS IN WANNIER BASIS. AND DIAGONALIZE
00066   !
00067   allocate(EKS(NWF,NTK)); EKS=0.0d0 
00068   allocate(VKS(NWF,NWF,NTK)); VKS=0.0d0 
00069   call make_eks(NTK,NWF,Na1,Na2,Na3,KS_R(1,1,-Na1,-Na2,-Na3),pf(-Na1,-Na2,-Na3,1),EKS(1,1),VKS(1,1,1))  
00070   !
00071   !3. KS-DOS CALC
00072   !
00073   ksdos=0.0d0 
00074   call calc_dos_KS(NWF,NTK,nkb1,nkb2,nkb3,nsgm,sgmw(1),EKS(1,1),SK0(1,1),idlt,dmnr,dmna,b1(1),b2(1),b3(1),ksdos(1)) 
00075   !
00076   deallocate(WEIGHT_R,EKS,VKS,pf) 
00077   !
00078 return 
00079 end