Commit 678ff868 authored by Gregor Michalicek's avatar Gregor Michalicek

Integrate bs_comfort call in fleur.F90

parent 8d295164
......@@ -136,6 +136,7 @@ MODULE m_fleur
USE m_wann_optional
USE m_wannier
USE m_bs_comfort
! USE m_mixedbasis
! USE m_coulomb
......@@ -630,6 +631,25 @@ MODULE m_fleur
input,noco,enpara%epara_min,jij,cell,results)
END IF
CALL timestop("determination of fermi energy")
!+Wannier
IF(wann%l_bs_comf)THEN
IF(pc.EQ.1) THEN
OPEN(777,file='out_eig.1')
OPEN(778,file='out_eig.2')
OPEN(779,file='out_eig.1_diag')
OPEN(780,file='out_eig.2_diag')
END IF
CALL bs_comfort(eig_id,DIMENSION,input,noco,kpts%nkpt,pc)
IF(pc.EQ.wann%nparampts)THEN
CLOSE(777)
CLOSE(778)
CLOSE(779)
CLOSE(780)
END IF
END IF
!-Wannier
END IF
IF (input%eonly) THEN
......@@ -712,11 +732,12 @@ MODULE m_fleur
!+Wannier functions
input%l_wann = .FALSE.
INQUIRE (file='wann_inp',exist=input%l_wann)
IF (input%l_wann) THEN
IF ((input%l_wann).AND.(.NOT.wann%l_bs_comf)) THEN
CALL wannier(DIMENSION,mpi,input,sym,atoms,stars,vacuum,sphhar,oneD,&
wann,noco,cell,enpara,banddos,sliceplot,results,&
eig_idList,l_real,kpts%nkpt)
END IF
IF (wann%l_gwf) CALL juDFT_error("provide wann_inp if l_gwf=T", calledby = "fleur")
!-Wannier
CALL timestart("generation of new charge density (total)")
......
MODULE m_bs_comfort
USE m_juDFT
CONTAINS
SUBROUTINE bs_comfort(
> neigd,nkptd,jspd,nwdd,ntypd,lmaxd,nlod,
> jspins,nwd,ntype,nkpt,ntapwf,irecl,
> delgau,film,l_noco,l_ss,
X l_disp,nkpt_l,eig_l,irank,isize,param,socfile)
SUBROUTINE bs_comfort(eig_id,DIMENSION,input,noco,nkpt,param)
#ifdef CPP_HDF
USE m_eig66_hdf, ONLY : read_eig, read_kptenpar
#endif
USE m_types
USE m_eig66_io, ONLY : read_eig
IMPLICIT NONE
C ..
TYPE(t_DIMENSION), INTENT(IN) :: DIMENSION
TYPE(t_input), INTENT(IN) :: input
TYPE(t_noco), INTENT(IN) :: noco
C .. Scalar Arguments ..
INTEGER, INTENT (IN) :: neigd,nkptd,jspd,nwdd,ntypd,lmaxd,nlod
INTEGER, INTENT (IN) :: jspins,nwd,ntype,irecl,ntapwf,nkpt_l
LOGICAL, INTENT (IN) :: film,socfile
LOGICAL, INTENT (IN) :: l_noco,l_ss,l_disp
REAL, INTENT (IN) :: delgau
INTEGER, INTENT (IN) :: irank,isize,param
C ..
C .. Array Arguments ..
INTEGER, INTENT (IN) :: nkpt(nwdd)
REAL, INTENT (IN) :: eig_l(neigd+5,nkpt_l)
INTEGER, INTENT (IN) :: eig_id
INTEGER, INTENT (IN) :: nkpt
INTEGER, INTENT (IN) :: param
C ..
C .. Local Scalars ..
REAL del,seigsc,seigv,spindg,ssc,weight,ws,zc,tkb_1
INTEGER i,idummy,j,jsp,k,l,n,nbands,nstef,nv,nw,nrec,nmat,nspins
INTEGER n_help
C ..
INTEGER :: i, jsp,k,nspins
C .. Local Arrays ..
C
REAL, ALLOCATABLE :: eig(:,:,:)
INTEGER ne(nkptd,jspd)
REAL bk(3,nkptd),el(0:lmaxd,ntypd,jspd),evac(2,jspd)
REAL wtkpt(nkptd),ello(nlod,ntypd,jspd)
INTEGER, ALLOCATABLE :: ne(:,:)
LOGICAL :: l_etotskip = .false.
REAL :: etotskip_val = 0.0
C ..
c***********************************************************************
c ABBREVIATIONS
c
c eig : array of eigenvalues within all energy-windows
c wtkpt : list of the weights of each k-point (from inp-file)
c e : linear list of the eigenvalues within the highest
c energy-window
c we : list of weights of the eigenvalues in e
c zelec : number of electrons in a window
c spindg : spindegeneracy (2 in nonmagnetic calculations)
c seigv : weighted sum of the occupied valence eigenvalues
c seigsc : weighted sum of the semi-core eigenvalues
c seigscv : sum of seigv and seigsc
C ts : entropy contribution to the free energy
c
c***********************************************************************
C .. Data statements ..
DATA del/1.0e-6/
C ..
ALLOCATE (eig(neigd,nkptd,jspd))
c
IF (socfile) THEN
IF (nwd/=1) THEN
CALL juDFT_error("eig.soc and multiple windows",calledby
+ ="bs_comfort")
ENDIF
OPEN(67,file='eig.soc',form='unformatted',action='read')
ENDIF
c
c---> READ IN EIGENVALUES
c
spindg = 2.0/real(jspins)
n = 0
nrec = 0
seigsc = 0.0
ssc = 0.0
n_help = 0
c
c---> pk non-collinear
IF (l_noco) THEN
IF (noco%l_noco) THEN
nspins = 1
ELSE
nspins = jspins
nspins = input%jspins
ENDIF
c---> pk non-collinear
c
DO 50 nw = 1,nwd
DO 40 jsp = 1,nspins
DO 30 k = 1,nkpt(nw)
100 CONTINUE
IF (socfile) THEN
IF (jsp==1) THEN
READ(67) i
IF (i/=k) THEN
CALL juDFT_error("error in eig.soc",
+ calledby ="bs_comfort")
ENDIF
READ(67) bk(1,k), bk(2,k), bk(3,k)
READ(67) wtkpt(k)
READ(67) ne(k,jsp)
DO i= 1,ne(k,jsp)
READ(67) eig(i,k,jsp)
ENDDO
ELSE
ne(k,jsp)= ne(k,1)
DO i= 1,ne(k,1)
eig(i,k,jsp)= eig(i,k,1)
ENDDO
ENDIF
nv= -1
ELSE
nrec = nrec + 1
#ifdef CPP_HDF
IF (nw>1) CALL juDFT_error("HDF and multiple windows.."
+ ,calledby ="bs_comfort")
CALL read_eig(k,jsp,ne(k,jsp),eig(:,k,jsp))
CALL read_kptenpar(k,jsp,bk(1,k),wtkpt(k),el(:,:,jsp),
+ ello(:,:,jsp),evac(1,jsp))
WRITE (6,'(a2,3f10.5,f12.6)') 'at',bk(:,k),wtkpt(k)
WRITE (6,'(i5,a14)') ne(k,jsp),' eigenvalues :'
WRITE (6,'(8f12.6)') (eig(i,k,jsp),i=1,ne(k,jsp))
nv= -1
#else
IF (l_ss) THEN
READ (ntapwf,rec=nrec) el,evac,ello,
+ (bk(i,k),i=1,3),wtkpt(k),
+ ne(k,jsp),nv,idummy,nmat,
+ (eig(i,k,jsp),i=1,neigd)
ELSEIF (l_noco) THEN
READ (ntapwf,rec=nrec) el,evac,ello,
+ (bk(i,k),i=1,3),wtkpt(k),
+ ne(k,jsp),nv,nmat,
+ (eig(i,k,jsp),i=1,neigd)
ELSE
READ (ntapwf,rec=nrec) el(:,:,jsp),evac(:,jsp),
+ ello(:,:,jsp),
+ (bk(i,k),i=1,3),wtkpt(k),
+ ne(k,jsp),nv,nmat,
+ (eig(i,k,jsp),i=1,neigd)
ENDIF
#endif
ENDIF!(socfile)
#ifdef CPP_MPI
IF (.NOT.socfile) THEN
n_help = n_help + ne(k,jsp)
IF (abs(evac(1,jsp)-999.9).LT.1.e-9) THEN
c
c obviously this record was only one part of a k-point
c
GOTO 100
ENDIF
ne(k,jsp) = n_help
n_help = 0
c write(*,'(8f10.5)') (e(n-ne(k,jsp)+i),i=1,ne(k,jsp))
ENDIF
#endif
30 CONTINUE
ALLOCATE (eig(DIMENSION%neigd,nkpt,nspins))
ALLOCATE (ne(nkpt,nspins))
IF(nw.EQ.nwd) THEN
DO 20 i=1,neigd
DO 10 k=1,nkpt(nw)
write(776+jsp,*)param,k,eig(i,k,jsp)
10 CONTINUE
write(776+jsp,*)
20 CONTINUE
DO jsp = 1, nspins
DO k = 1, nkpt
CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp))
END DO ! k = 1,nkpt
DO 21 i=1,neigd
DO 11 k=1,nkpt(nw)
if(k.eq.param)write(778+jsp,*)param,k,eig(i,k,jsp)
11 CONTINUE
write(778+jsp,*)
21 CONTINUE
ENDIF
DO i = 1, DIMENSION%neigd
DO k = 1, nkpt
WRITE(776+jsp,*) param,k,eig(i,k,jsp)
END DO
WRITE(776+jsp,*)
END DO
40 CONTINUE
50 CONTINUE
DO i = 1, DIMENSION%neigd
DO k = 1, nkpt
IF (k.eq.param) WRITE(778+jsp,*) param,k,eig(i,k,jsp)
END DO
WRITE(778+jsp,*)
END DO
END DO ! jsp = 1,nspins
DEALLOCATE ( eig )
DEALLOCATE (ne,eig)
RETURN
END SUBROUTINE bs_comfort
END MODULE m_bs_comfort
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment