00001 module m_hist
00002 implicit none
00003 contains
00004
00005 subroutine calculate_hist(Ndim_TR,delw,TR)
00006 implicit none
00007 integer,intent(in)::Ndim_TR
00008 real(8),intent(in)::delw
00009 complex(8),intent(inout)::TR(Ndim_TR,Ndim_TR)
00010
00011 real(8),allocatable::EIG_TR(:)
00012 real(8),allocatable::hist(:)
00013 real(8)::emin,emax
00014 integer::ndosgrd
00015 integer::emin_grd,emax_grd
00016
00017
00018
00019 allocate(EIG_TR(Ndim_TR)); EIG_TR=0.0d0
00020 call diagN(Ndim_TR,TR(1,1),EIG_TR(1))
00021
00022
00023
00024 call est_ndosgrd(Ndim_TR,1,EIG_TR(1),delw,emin,emax,ndosgrd)
00025
00026
00027
00028 emin_grd=nint(emin/delw)
00029 emax_grd=nint(emax/delw)
00030 allocate(hist(emin_grd:emax_grd)); hist=0.0d0
00031 call calc_hist(Ndim_TR,emin_grd,emax_grd,delw,EIG_TR(1),hist(emin_grd))
00032
00033
00034
00035 call wrt_hist(emin_grd,emax_grd,delw,hist(emin_grd))
00036 deallocate(EIG_TR,hist)
00037
00038 return
00039 end subroutine
00040
00041 subroutine est_ndosgrd(NTB,NTK,E_EIG,deltw,emin,emax,ndosgrd)
00042 implicit none
00043 integer,intent(in)::NTB,NTK
00044 real(8),intent(in)::E_EIG(NTB,NTK)
00045 real(8),intent(in)::deltw
00046 real(8),intent(out)::emax,emin
00047 integer,intent(out)::ndosgrd
00048 real(8)::diff
00049 real(8),parameter::au=27.21151d0
00050
00051 emax=maxval(E_EIG)
00052 emin=minval(E_EIG)
00053 diff=emax-emin
00054
00055
00056
00057 ndosgrd=int(2.0d0*diff/deltw)+1
00058 emax=emax+0.5d0*diff
00059 emin=emin-0.5d0*diff
00060
00061 write(6,*)
00062 write(6,'(a)')'GRID DATA FOR DOS'
00063 write(6,'(a10,f12.7)')'emin(eV)',emin*au
00064 write(6,'(a10,f12.7)')'emax(eV)',emax*au
00065 write(6,'(a10,f12.7)')'deltw(eV)',deltw*au
00066 write(6,'(a10,i12)')'ndosgrd',ndosgrd
00067 write(6,*)
00068 return
00069 end subroutine
00070
00071 subroutine diagN(nm,mat,eig)
00072 implicit none
00073 integer,intent(in)::nm
00074 complex(8),intent(inout)::mat(nm,nm)
00075 real(8),intent(out)::eig(nm)
00076 integer::LWORK,LRWORK,LIWORK
00077 integer,allocatable::iwork_zheevd(:)
00078 real(8),allocatable::rwork_zheevd(:)
00079 complex(8),allocatable::work_zheevd(:)
00080 integer::ind
00081 real(8)::eps
00082
00083 LWORK= 2*nm+nm**2
00084 LRWORK=1+12*nm+3*nm**2
00085 LIWORK=3+10*nm
00086 allocate(work_zheevd(LWORK));work_zheevd(:)=0.0d0
00087 allocate(rwork_zheevd(LRWORK));rwork_zheevd(:)=0.0d0
00088 allocate(iwork_zheevd(LIWORK));iwork_zheevd(:)=0
00089 eps=1.0d-18
00090 ind=0
00091
00092 call zheevd("N","U",nm,mat,nm,eig,work_zheevd,LWORK,rwork_zheevd,LRWORK,iwork_zheevd,LIWORK,ind)
00093
00094 if(ind/=0)then
00095 write(6,*)'ind=',ind
00096 stop
00097 endif
00098
00099 deallocate(work_zheevd,rwork_zheevd,iwork_zheevd)
00100 return
00101 end subroutine
00102
00103 subroutine calc_hist(N_eig,N_ini,N_end,del,EIG,hist)
00104 implicit none
00105 integer,intent(in)::N_eig,N_ini,N_end
00106 real(8),intent(in)::del
00107 real(8),intent(in)::EIG(N_eig)
00108 real(8),intent(out)::hist(N_ini:N_end)
00109 integer::ie,ix
00110 real(8),parameter::au=27.21151d0
00111
00112 hist=0.0d0
00113 do ie=1,N_eig
00114 ix=nint(EIG(ie)/del)
00115 hist(ix)=hist(ix)+1.0d0
00116 enddo
00117
00118 return
00119 end subroutine
00120
00121 subroutine wrt_hist(emin_grd,emax_grd,delw,hist)
00122 implicit none
00123 integer,intent(in)::emin_grd,emax_grd
00124 real(8),intent(in)::delw
00125 real(8),intent(in)::hist(emin_grd:emax_grd)
00126 integer::ix
00127 real(8),parameter::au=27.21151d0
00128
00129
00130
00131 OPEN(302,file='./dat.hist')
00132 rewind(302)
00133 do ix=emin_grd,emax_grd
00134 write(302,'(2f15.10)') dble(ix)*delw*au,hist(ix)/au
00135 enddo
00136 close(302)
00137
00138 return
00139 end subroutine
00140
00141 end module m_hist