Commit 3a9e48f9 authored by Gregor Michalicek's avatar Gregor Michalicek

More work for the Wannier integration, including integration of first initializations in fleur

parent f6aaa0ed
......@@ -843,6 +843,27 @@
integer :: gfcut
integer :: unigrid(6)
integer :: mhp(3)
!---> gwf
LOGICAL :: l_ms
LOGICAL :: l_sgwf
LOGICAL :: l_socgwf
LOGICAL :: l_gwf
LOGICAL :: l_bs_comf
LOGICAL :: l_exist
LOGICAL :: l_opened
LOGICAL :: l_cleverskip
LOGICAL :: l_dim(3)
REAL :: scale_param
REAL :: aux_latt_const
REAL :: hdwf_t1
REAL :: hdwf_t2
INTEGER :: nparampts
CHARACTER(len=20) :: fn_eig
CHARACTER(len=20) :: param_file
REAL,ALLOCATABLE :: param_vec(:,:)
REAL,ALLOCATABLE :: param_alpha(:,:)
!---> gwf
end type t_wann
END
......@@ -178,6 +178,7 @@
TYPE(t_hybrid) :: hybrid
TYPE(t_oneD) :: oneD
TYPE(t_mpi) :: mpi
TYPE(t_wann) :: wann
! .. Local Scalars ..
......@@ -209,7 +210,7 @@
CALL timestart("Initialization")
CALL fleur_init(mpi,input,dimension,atoms,sphhar,cell,stars,sym,noco,vacuum,&
sliceplot,banddos,obsolete,enpara,xcpot,results,jij,kpts,hybrid,&
oneD,l_opti)
oneD,wann,l_opti)
CALL timestop("Initialization")
IF (l_opti) THEN
......@@ -238,9 +239,10 @@
#ifdef CPP_WANN
input%l_wann = .FALSE.
INQUIRE (file='wann_inp',exist=input%l_wann)
IF (input%l_wann .AND. (mpi%irank == 0))THEN
CALL wann_optional(input,atoms,sym,cell,oneD,noco)
ENDIF
IF (input%l_wann.AND.(mpi%irank==0).AND.(.NOT.wann%l_bs_comf)) THEN
CALL wann_optional(input,atoms,sym,cell,oneD,noco,wann)
END IF
IF (wann%l_gwf) input%itmax=1
#endif
l_restart = .TRUE.
......@@ -695,7 +697,7 @@
CALL wannier(mpi,atoms,noco,&
& dimension,sym,obsolete,cell,kpts,&
& stars,oneD,vacuum,sphhar,input,&
& sliceplotresults)
& sliceplot,results)
ENDIF
#endif
!-Wannier
......
......@@ -9,7 +9,7 @@
SUBROUTINE fleur_init(mpi,&
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,&
sliceplot,banddos,obsolete,enpara,xcpot,results,jij,kpts,hybrid,&
oneD,l_opti)
oneD,wann,l_opti)
USE m_judft
USE m_juDFT_init
USE m_types
......@@ -60,6 +60,7 @@
TYPE(t_kpts) ,INTENT(OUT):: kpts
TYPE(t_hybrid) ,INTENT(OUT):: hybrid
TYPE(t_oneD) ,INTENT(OUT):: oneD
TYPE(t_wann) ,INTENT(OUT):: wann
LOGICAL, INTENT(OUT):: l_opti
......@@ -70,14 +71,14 @@
LOGICAL, ALLOCATABLE :: xmlPrintCoreStates(:,:)
CHARACTER(len=3), ALLOCATABLE :: noel(:)
! .. Local Scalars ..
INTEGER :: i,n,l,m1,m2,isym,iisym,numSpecies
INTEGER :: i,n,l,m1,m2,isym,iisym,numSpecies,pc,iAtom,iType
COMPLEX :: cdum
CHARACTER(len=4) :: namex
CHARACTER(len=12) :: relcor, tempNumberString
CHARACTER(LEN=20) :: filename
REAL :: a1(3),a2(3),a3(3)
REAL :: scale, dtild
LOGICAL :: l_found, l_kpts, l_gga
REAL :: scale, dtild, phi_add
LOGICAL :: l_found, l_kpts, l_gga, l_exist
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -550,6 +551,113 @@
sym%nsym = 2*sym%nop
END IF
! Initializations for Wannier functions (start)
wann%l_ms=.false.
wann%l_sgwf=.false.
wann%l_socgwf=.false.
wann%l_gwf=.false.
wann%l_bs_comf=.false. !.true.
wann%scale_param = 1.0
wann%aux_latt_const = 8.0!5.5!5.45886450 !5.98136400 !8.0725882513951497 !5.4170 !1.0
wann%param_file='qpts'
wann%l_dim=.false.
IF (mpi%irank.EQ.0) THEN
INQUIRE(FILE='plotbscomf',EXIST=wann%l_bs_comf)
WRITE(*,*)'l_bs_comf=',wann%l_bs_comf
WRITE(*,*) 'Logical variables for wannier functions to be read in!!'
wann%l_gwf = wann%l_ms.or.wann%l_sgwf.or.wann%l_socgwf
if(wann%l_gwf) then
WRITE(*,*)'running HDWF-extension of FLEUR code'
WRITE(*,*)'with l_sgwf =',wann%l_sgwf,' and l_socgwf =',wann%l_socgwf
IF(wann%l_socgwf.AND. .NOT.noco%l_soc) THEN
CALL juDFT_error("set l_soc=T if l_socgwf=T",calledby="fleur_init")
END IF
IF((wann%l_ms.or.wann%l_sgwf).AND..NOT.(noco%l_noco.AND.noco%l_ss)) THEN
CALL juDFT_error("set l_noco=l_ss=T for l_sgwf.or.l_ms",calledby="fleur_init")
END IF
IF((wann%l_ms.or.wann%l_sgwf).and.wann%l_socgwf) THEN
CALL juDFT_error("(l_ms.or.l_sgwf).and.l_socgwf",calledby="fleur_init")
END IF
INQUIRE(FILE=wann%param_file,EXIST=l_exist)
IF(.NOT.l_exist) THEN
CALL juDFT_error("where is param_file"//trim(wann%param_file)//"?",calledby="fleur_init")
END IF
OPEN (113,file=wann%param_file,status='old')
READ (113,*) wann%nparampts,wann%scale_param
CLOSE(113)
ELSE
wann%nparampts=1
wann%scale_param=1.0
END IF
END IF
#ifdef CPP_MPI
CALL MPI_BCAST(wann%l_bs_comf,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(wann%l_gwf,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(wann%nparampts,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(wann%scale_param,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(wann%l_sgwf,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_BCAST(wann%l_socgwf,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_BCAST(wann%l_ms,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
#endif
ALLOCATE (wann%param_vec(3,wann%nparampts))
ALLOCATE (wann%param_alpha(atoms%ntype,wann%nparampts))
IF(mpi%irank.EQ.0) THEN
IF(wann%l_gwf) THEN
OPEN(113,file=wann%param_file,status='old')
READ(113,*)!header
write(6,*) 'parameter points for HDWFs generation:'
IF(wann%l_sgwf.or.wann%l_ms) THEN
WRITE(6,*)' q1 ',' q2 ',' q3'
ELSE IF(wann%l_socgwf) THEN
WRITE(6,*)' -- ',' phi ',' theta'
END IF
DO pc = 1, wann%nparampts
READ(113,'(3(f14.10,1x))') wann%param_vec(1,pc), wann%param_vec(2,pc), wann%param_vec(3,pc)
wann%param_vec(:,pc) = wann%param_vec(:,pc) / wann%scale_param
WRITE(6,'(3(f14.10,1x))') wann%param_vec(1,pc), wann%param_vec(2,pc), wann%param_vec(3,pc)
IF(wann%l_sgwf.or.wann%l_ms) THEN
iAtom = 1
DO iType = 1, atoms%ntype
phi_add = tpi_const*(wann%param_vec(1,pc)*atoms%taual(1,iAtom) +&
wann%param_vec(2,pc)*atoms%taual(2,iAtom) +&
wann%param_vec(3,pc)*atoms%taual(3,iAtom))
wann%param_alpha(iType,pc) = noco%alph(iType) + phi_add
iAtom = iAtom + atoms%neq(iType)
END DO
END IF
END DO
IF(ANY(wann%param_vec(1,:).NE.wann%param_vec(1,1))) wann%l_dim(1)=.true.
IF(ANY(wann%param_vec(2,:).NE.wann%param_vec(2,1))) wann%l_dim(2)=.true.
IF(ANY(wann%param_vec(3,:).NE.wann%param_vec(3,1))) wann%l_dim(3)=.true.
CLOSE(113)
IF(wann%l_dim(1).and.wann%l_socgwf) THEN
CALL juDFT_error("do not specify 1st component if l_socgwf",calledby="fleur_init")
END IF
END IF!(wann%l_gwf)
END IF!(mpi%irank.EQ.0)
#ifdef CPP_MPI
CALL MPI_BCAST(wann%param_vec,3*wann%nparampts,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
CALL MPI_BCAST(wann%param_alpha,atoms%ntype*wann%nparampts,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
CALL MPI_BCAST(wann%l_dim,3,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
#endif
! Initializations for Wannier functions (end)
IF ( (xcpot%icorr.EQ.icorr_hf ) .OR. (xcpot%icorr.EQ.icorr_pbe0)&
& .OR.(xcpot%icorr.EQ.icorr_exx) .OR. (xcpot%icorr.EQ.icorr_hse)&
......
......@@ -94,6 +94,7 @@ wannier/wann_write_mmnk2.F
wannier/wann_write_mmnk.F
wannier/wann_write_nabla.F
wannier/wann_plot_od_vac.F
wannier/bs_comfort.F
)
set(fleur_F90 ${fleur_F90}
)
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)
#ifdef CPP_HDF
USE m_eig66_hdf, ONLY : read_eig, read_kptenpar
#endif
IMPLICIT NONE
C ..
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)
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 ..
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)
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
nspins = 1
ELSE
nspins = 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
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 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
40 CONTINUE
50 CONTINUE
DEALLOCATE ( eig )
RETURN
END SUBROUTINE bs_comfort
END MODULE m_bs_comfort
......@@ -8,7 +8,7 @@
use m_juDFT
contains
subroutine wann_optional(
> input,atoms,sym,cell,oneD,noco,
> input,atoms,sym,cell,oneD,noco,wann,
> l_ms,l_sgwf,l_socgwf,
> aux_latt_const,param_file,l_dim)
c**************************************************
......@@ -29,17 +29,17 @@ c**************************************************
implicit none
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_wann), INTENT(INOUT) :: wann
real,intent(in) :: aux_latt_const
character(len=20),intent(in) :: param_file
type(t_wann) :: wann
integer :: num_wann(2)
logical :: l_nocosoc
......
......@@ -9,7 +9,7 @@
CONTAINS
SUBROUTINE wannier(
> DIMENSION,mpi,input,sym,atoms,stars,vacuum,sphhar,lapw,oneD,
> noco,cell,enpara,banddos,sliceplot,odi,ods,results,
> wann,noco,cell,enpara,banddos,sliceplot,odi,ods,results,
> l_real,nkpt,nkptd,k1d,k2d,k3d,
> l_ms,l_sgwf,l_socgwf,aux_latt_const,
> param_file,param_vec,nparampts,param_alpha,l_dim)
......@@ -133,9 +133,10 @@ ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_sliceplot), INTENT(IN) :: sliceplot
type (od_inp), INTENT(IN) :: odi
type (od_sym), INTENT(IN) :: ods
TYPE(od_inp), INTENT(IN) :: odi
TYPE(od_sym), INTENT(IN) :: ods
TYPE(t_results), INTENT(IN) :: results
TYPE(t_wann), INTENT(INOUT) :: wann
logical, intent (in) :: l_real
integer, intent (in) :: nkptd
......@@ -151,7 +152,6 @@ ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
character(len=20),intent(in) :: param_file
cccccccccccccccccc local variables cccccccccccccccccccc
type(t_wann) :: wann
integer :: lmd,nlotot,n,nmat,iter,ikpt,ikpt_b,nmat_b
integer :: addnoco,funbas,loplod,addnoco2,igvm2,eig_id
integer :: noccbd,noccbd_b,nn,nkpts,i,jspin,j,l,i_rec,m,nwf,nwfp
......
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