Commit 1b539112 authored by Daniel Wortmann's avatar Daniel Wortmann

Modifications mostly for IO

parent 16794026
......@@ -6,7 +6,7 @@
MODULE m_eparas
!***********************************************************************
! Calculates qlo, enerlo and sqlo, which are needed to determine the
! Calculates qlo, enerlo and sqlo, which are needed to determine the
! new energy parameters.
! Philipp Kurz 99/04
!***********************************************************************
......@@ -26,6 +26,7 @@ CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd,ev_list,mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,dos,l_mcd,mcd)
USE m_types
use m_types_dos
IMPLICIT NONE
TYPE(t_usdus), INTENT(IN) :: usdus
TYPE(t_mpi), INTENT(IN) :: mpi
......@@ -36,14 +37,14 @@ CONTAINS
TYPE(t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd,jsp
INTEGER, INTENT (IN) :: noccbd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t
LOGICAL, INTENT (IN) :: l_mcd,l_evp
INTEGER, INTENT (IN) :: ev_list(noccbd)
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: eig(:)!(input%neig),
REAL, INTENT (IN) :: we(noccbd)
REAL, INTENT (IN) :: we(noccbd)
! ..
! .. Local Scalars ..
......@@ -88,7 +89,7 @@ CONTAINS
sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
ENDDO
ELSE
suma = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.)
suma = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.)
sumb = CMPLX(0.,0.) ; sumba = CMPLX(0.,0.)
DO natom = nt1,nt2
suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
......@@ -103,7 +104,7 @@ CONTAINS
suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1) +&
sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2) +&
sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1) +&
sumba* CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,2) )
sumba* CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,2) )
ENDDO
ENDDO
ENDIF ! end MCD
......
......@@ -19,6 +19,10 @@ CONTAINS
USE m_unfold_band_kpts
USE m_cdninf
USE m_types_eigdos
#ifdef CPP_HDF
use m_hdf_tools
#endif
use m_banddos_io
IMPLICIT NONE
......@@ -39,24 +43,23 @@ CONTAINS
INTEGER :: ne,ikpt,kspin,j,i,n
LOGICAL :: l_error
real :: eFermiPrev
#ifdef CPP_HDF
INTEGER(HID_t):: banddosFile_id
#else
INTEGER :: banddosFile_id
#endif
CALL readPrevEFermi(eFermiPrev,l_error)
eFermiPrev=merge(results%ef,eFermiPrev,l_error)
IF (banddos%band) THEN
#ifdef CPP_HDF
! CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts,banddos)
! CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
! CALL closeBandDOSFile(banddosFile_id)
#else
open(888,file="eigdesc.bin")
write(888) eFermiPrev,4
DO n=1,size(eigdos)
CALL eigdos(n)%p%write(888)
ENDDO
close(888)
CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts,banddos)
#endif
IF (banddos%band) THEN
! CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
DO n=1,size(eigdos)
call eigdos(n)%p%write_band(kpts,cell,banddosFile_id)
enddo
IF (banddos%unfoldband) &
CALL write_band_sc(kpts,results,eFermiPrev)
ENDIF
......@@ -73,9 +76,12 @@ CONTAINS
print *,"Smooth:",n
call eigdos(n)%p%smooth(banddos)
print *,"WriteDos:",n
call eigdos(n)%p%write_dos()
call eigdos(n)%p%write_dos(banddosFile_id)
enddo
endif
#ifdef CPP_HDF
CALL closeBandDOSFile(banddosFile_id)
#endif
RETURN
END SUBROUTINE make_dos
......
......@@ -11,7 +11,7 @@ MODULE m_types_eigdos
PUBLIC:: t_eigdos,t_eigdos_list,t_eigdos_make_dos
TYPE,abstract :: t_eigdos
CHARACTER(len=20) :: name_of_dos="DOS"
CHARACTER(len=20) :: name_of_dos="unnamed"
!each eigenvalue might be described by weights
REAL,ALLOCATABLE :: eig(:,:,:)
REAL,ALLOCATABLE :: dos_grid(:) !This is the grid the DOS part uses internally (FOR IO use the routine below)
......@@ -20,13 +20,15 @@ MODULE m_types_eigdos
procedure(get_weight_name),DEFERRED :: get_weight_name
procedure(get_num_weights),DEFERRED :: get_num_weights
procedure(get_weight_eig),DEFERRED :: get_weight_eig !should be overwritten in derived type
procedure :: get_dims
procedure :: get_spins
procedure :: get_neig
procedure :: get_eig
procedure :: get_dos_grid
procedure :: make_dos=>t_eigdos_make_dos
procedure :: smooth=>dosdata_smooth
procedure :: write_raw
procedure :: write_raw !should be implemented later to allow eig66 functionality
procedure :: write_dos
procedure :: write_band
END TYPE
type::t_eigdos_list
......@@ -56,16 +58,27 @@ MODULE m_types_eigdos
end interface
CONTAINS
function get_neig(this)
CLASS(t_eigdos),INTENT(IN)::this
integer,allocatable :: get_neig(:,:)
real,allocatable::ev(:,:,:)
integer ::k,j
ev=this%get_eig()
allocate(get_neig(size(ev,2),size(ev,3)))
DO j=1,this%get_spins()
DO k=1,size(ev,2)
get_neig(k,j)=count(ev(:,k,j)<1E99)
ENDDO
ENDDO
end function
function get_dims(this)
pure integer function get_spins(this)
CLASS(t_eigdos),INTENT(IN)::this
INTEGER :: get_dims(2)
get_dims(1)=size(this%eig,1)
get_dims(2)=size(this%eig,3)
get_spins=size(this%eig,3)
END function
function get_eig(this,id)
function get_eig(this)
CLASS(t_eigdos),INTENT(IN):: this
INTEGER,INTENT(IN) :: id
real,allocatable:: get_eig(:,:,:)
get_eig=this%eig
END function
......@@ -105,10 +118,22 @@ subroutine dosdata_smooth(eigdos,banddos)
ENDDO
END subroutine
subroutine write_dos(eigdos,filename)
subroutine write_dos(eigdos,hdf_id)
#ifdef CPP_HDF
use HDF5
use m_banddos_io
#endif
class(t_eigdos),INTENT(INOUT):: eigdos
character(len=*),OPTIONAL,intent(in)::filename
#ifdef CPP_HDF
integer(HID_T),intent(in) ::hdf_id
integer:: n
DO n=1,eigdos%get_num_weights()
print *, "writedos:",n,eigdos%get_num_weights()
call writedosData(hdf_ID,eigdos%name_of_dos,eigdos%get_dos_grid(),eigdos%get_weight_name(n),eigdos%dos(:,:,n))
enddo
#else
integer,intent(in):: hdf_id !not used
integer:: jspin,i,ind,id
character(len=100)::file
real,allocatable:: dos_grid(:)
......@@ -117,11 +142,7 @@ subroutine write_dos(eigdos,filename)
if (size(eigdos%dos)==0) return
DO jspin=1,size(eigdos%dos,2)
if (present(filename)) THEN
write(file,"(a,a,i0)") trim(adjustl(filename)),".",jspin
ELSE
write(file,"(a,a,i0)") trim(eigdos%name_of_dos),".",jspin
ENDIF
write(file,"(a,a,i0)") trim(eigdos%name_of_dos),".",jspin
open(999,file=file)
write(999,"(999a21)") "#energy",(eigdos%get_weight_name(id),id=1,eigdos%get_num_weights())
write(*,"(999a21)") file,(eigdos%get_weight_name(id),id=1,eigdos%get_num_weights())
......@@ -132,8 +153,54 @@ subroutine write_dos(eigdos,filename)
close(999)
write(*,*) "done:",file
ENDDO
#endif
END subroutine
subroutine write_band(eigdos,kpts,cell,hdf_id)
use m_types_kpts
use m_types_cell
#ifdef CPP_HDF
use HDF5
use m_banddos_io
#endif
class(t_eigdos),INTENT(INOUT):: eigdos
type(t_kpts),intent(in) :: kpts
type(t_cell),intent(in) :: cell
#ifdef CPP_HDF
integer(HID_T),intent(in) ::hdf_id
INTEGER::n
DO n=1,eigdos%get_num_weights()
call writebandData(hdf_id,eigdos%name_of_dos,eigdos%get_weight_name(n),eigdos%get_eig(),eigdos%get_weight_eig(n),kpts)
enddo
#else
integer,intent(in):: hdf_id !not used
integer:: jspin,i,k
real,allocatable :: ev(:,:,:),kx(:)
real :: vkr(3),vkr_prev(3)
character(len=100)::file
allocate(kx(kpts%nkpt))
DO jspin=1,eigdos%get_spins()
write(file,"(a,a,i0)") trim(eigdos%name_of_dos),".",jspin
open(18,file=file)
ev=eigdos%get_eig()
kx(1) = 0.0
vkr_prev=matmul(kpts%bk(:,1),cell%bmat)
DO k = 2, kpts%nkpt
vkr=matmul(kpts%bk(:,k),cell%bmat)
kx(k)=kx(k-1)+ sqrt(dot_product(vkr-vkr_prev,vkr-vkr_prev))
vkr_prev=vkr
ENDDO
DO i = 1, minval(eigdos%get_neig())
DO k = 1, kpts%nkpt
write(18,'(2f15.9)') kx(k),ev(i,k,jspin)!-eFermiCorrection
ENDDO
ENDDO
CLOSE (18)
enddo
#endif
end subroutine
subroutine t_eigdos_make_dos(eigdos,kpts,input,banddos,efermi)
use m_types_banddos
use m_types_input
......@@ -147,14 +214,14 @@ subroutine write_dos(eigdos,filename)
type(t_input),intent(in) :: input
real,intent(in) :: efermi
integer ::n,dims(2)
integer ::n
real :: emin,emax
emin=min(banddos%e1_dos,banddos%e2_dos)-efermi
emax=max(banddos%e1_dos,banddos%e2_dos)-efermi
if (allocated(eigdos%dos)) return
dims=eigdos%get_dims()
allocate(eigdos%dos(banddos%ndos_points,dims(2),eigdos%get_num_weights()))
allocate(eigdos%dos(banddos%ndos_points,eigdos%get_spins(),eigdos%get_num_weights()))
!Generate DOS grid
if (allocated(eigdos%dos_grid)) deallocate(eigdos%dos_grid)
allocate(eigdos%dos_grid(banddos%ndos_points))
......@@ -163,11 +230,11 @@ subroutine write_dos(eigdos,filename)
ENDDO
DO n=1,eigdos%get_num_weights()
print *,eigdos%name_of_dos,n
print *,eigdos%name_of_dos,n,eigdos%get_num_weights()
if (kpts%ntet==0) then
call dos_bin(input%jspins,kpts%wtkpt,eigdos%dos_grid,eigdos%get_eig(n),eigdos%get_weight_eig(n),eigdos%dos(:,:,n))
call dos_bin(input%jspins,kpts%wtkpt,eigdos%dos_grid,eigdos%get_eig(),eigdos%get_weight_eig(n),eigdos%dos(:,:,n))
ELSE
CALL dostetra(kpts,input,eigdos%dos_grid,eigdos%get_eig(n),eigdos%get_weight_eig(n),eigdos%dos(:,:,n))
CALL dostetra(kpts,input,eigdos%dos_grid,eigdos%get_eig(),eigdos%get_weight_eig(n),eigdos%dos(:,:,n))
endif
end do
END subroutine
......
......@@ -104,14 +104,16 @@ function get_weight_eig(this,id)
DO ntype=1,size(this%ncore)
DO nc=1,this%ncore(ntype)
ind=ind+1
if (ind==id) THEN
get_weight_eig=this%mcd(ntype,nc,:,:,:)
RETURN
ELSE IF(ind>id) then
CALL judft_error("Types_mcd: data not found")
ENDIF
if (ind==id) get_weight_eig=this%mcd(ntype,nc,:,:,:)
ind=ind+1
if (ind==id) get_weight_eig=this%mcd(ntype+1,nc,:,:,:)
ind=ind+1
if (ind==id) get_weight_eig=this%mcd(ntype+2,nc,:,:,:)
IF(ind>id) return
ENDDO
ENDDO
IF(ind>id)CALL judft_error("Types_mcd: data not found")
END function
integer function get_num_weights(this)
......@@ -123,23 +125,23 @@ end function
class(t_mcd),intent(in):: this
INTEGER,intent(in) :: id
character:: c
character(len=3):: c
INTEGER :: ind,ntype,nc,n
ind=0
DO n=1,size(this%ncore)
DO n=1,size(this%mcd,1)
ntype=n/3+1
select case(mod(n,3))
case(0)
c="+"
case(1)
c="-"
c="pos"
case(2)
c="-"
c="neg"
case(0)
c="cir"
end select
DO nc=1,this%ncore(ntype)
ind=ind+1
if (ind==id) THEN
write(get_weight_name,"(a,i0,a,i0,a)") "At:",ntype,",NC:",nc,c
write(get_weight_name,"(a,i0,a,i0,a)") "At",ntype,"NC",nc,c
RETURN
ELSE IF(ind>id) then
CALL judft_error("Types_mcd: data not found")
......
hdf5-git @ 9abbdeaa
Subproject commit d818edb110b668489d5c33ebc5c94dd9ef767121
Subproject commit 9abbdeaa66c70a00b6a7bedee9c76d2493a8e947
Subproject commit 280f38267410f085244732a1577f09433fa1500f
Subproject commit e7d99402a75476771a338ab8e77d0fe37af00e38
......@@ -102,7 +102,7 @@ ${FLEUR_SRC}/types/types_setup.F90
${FLEUR_SRC}/types/types_usdus.F90
${FLEUR_SRC}/types/types_cdnval.f90
${FLEUR_SRC}/types/types_regionCharges.f90
${FLEUR_SRC}/types/types_dos.f90
#${FLEUR_SRC}/types/types_dos.f90
${FLEUR_SRC}/types/types_denCoeffsOffdiag.f90
${FLEUR_SRC}/types/types_gpumat.F90
......
......@@ -23,13 +23,18 @@ MODULE m_banddos_io
IMPLICIT NONE
PUBLIC openBandDOSFile, closeBandDOSFile, writeBandDOSData
PUBLIC openBandDOSFile, closeBandDOSFile, writeBandData, writedosData
CONTAINS
SUBROUTINE openBandDOSFile(fileID, input, atoms, cell, kpts, banddos)
USE m_types
USE m_types_input
USE m_types_atoms
USE m_types_cell
USE m_types_kpts
USE m_types_banddos
USE hdf5
USE m_cdn_io
......@@ -81,7 +86,7 @@ MODULE m_banddos_io
INQUIRE(FILE=TRIM(ADJUSTL(filename)),EXIST=l_exist)
IF(l_exist) THEN
CALL system('rm '//TRIM(ADJUSTL(filename)))
CALL system('rm '//TRIM(ADJUSTL(filename)))
END IF
CALL h5fcreate_f(TRIM(ADJUSTL(filename)), H5F_ACC_TRUNC_F, fileID, hdfError, H5P_DEFAULT_F, H5P_DEFAULT_F)
......@@ -220,87 +225,38 @@ MODULE m_banddos_io
END SUBROUTINE
SUBROUTINE writeBandDOSData(fileID,input,atoms,cell,kpts,results,banddos,dos,vacuum)
USE m_types
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_results), INTENT(IN) :: results
TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_dos), INTENT(IN) :: dos
TYPE(t_vacuum), INTENT(IN) :: vacuum
SUBROUTINE writeBandData(fileID,name_of_dos,weight_name,eig,weight_eig,kpts)
USE m_types_kpts
character(len=*),intent(in) :: name_of_dos
character(len=*),intent(in) :: weight_name
real,intent(in) :: eig(:,:,:),weight_eig(:,:,:)
type(t_kpts),intent(in) :: kpts
INTEGER :: neigd
INTEGER(HID_T), INTENT(IN) :: fileID
INTEGER(HID_T) :: eigenvaluesGroupID
INTEGER(HID_T) :: bandUnfoldingGroupID
INTEGER(HID_T) :: eigenvaluesSpaceID, eigenvaluesSetID
INTEGER(HID_T) :: numFoundEigsSpaceID, numFoundEigsSetID
INTEGER(HID_T) :: lLikeChargeSpaceID, lLikeChargeSetID
INTEGER(HID_T) :: jsymSpaceID, jsymSetID
INTEGER(HID_T) :: ksymSpaceID, ksymSetID
INTEGER(HID_T) :: bUWeightsSpaceID, bUWeightsSetID
INTEGER(HID_T) :: supercellSpaceID, supercellSetID
INTEGER :: hdfError, dimsInt(7)
INTEGER(HSIZE_T) :: dims(7)
neigd = MAXVAL(results%neig(:,:))
CALL h5gcreate_f(fileID, '/eigenvalues', eigenvaluesGroupID, hdfError)
CALL io_write_attint0(eigenvaluesGroupID,'neigd',neigd)
CALL io_write_attint0(eigenvaluesGroupID,'maxL',3)
dims(:2)=(/kpts%nkpt,input%jspins/)
dimsInt=dims
CALL h5screate_simple_f(2,dims(:2),numFoundEigsSpaceID,hdfError)
CALL h5dcreate_f(eigenvaluesGroupID, "numFoundEigenvals", H5T_NATIVE_INTEGER, numFoundEigsSpaceID, numFoundEigsSetID, hdfError)
CALL h5sclose_f(numFoundEigsSpaceID,hdfError)
CALL io_write_integer2(numFoundEigsSetID,(/1,1/),dimsInt(:2),results%neig)
CALL h5dclose_f(numFoundEigsSetID, hdfError)
dims(:3)=(/neigd,kpts%nkpt,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),eigenvaluesSpaceID,hdfError)
CALL h5dcreate_f(eigenvaluesGroupID, "eigenvalues", H5T_NATIVE_DOUBLE, eigenvaluesSpaceID, eigenvaluesSetID, hdfError)
CALL h5sclose_f(eigenvaluesSpaceID,hdfError)
CALL io_write_real3(eigenvaluesSetID,(/1,1,1/),dimsInt(:3),results%eig(:neigd,:,:))
CALL h5dclose_f(eigenvaluesSetID, hdfError)
dims(:5)=(/4,atoms%ntype,neigd,kpts%nkpt,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(5,dims(:5),lLikeChargeSpaceID,hdfError)
CALL h5dcreate_f(eigenvaluesGroupID, "lLikeCharge", H5T_NATIVE_DOUBLE, lLikeChargeSpaceID, lLikeChargeSetID, hdfError)
CALL h5sclose_f(lLikeChargeSpaceID,hdfError)
CALL io_write_real5(lLikeChargeSetID,(/1,1,1,1,1/),dimsInt(:5),dos%qal(0:3,:,:neigd,:,:))
CALL h5dclose_f(lLikeChargeSetID, hdfError)
dims(:3)=(/neigd,kpts%nkpt,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),jsymSpaceID,hdfError)
CALL h5dcreate_f(eigenvaluesGroupID, "jsym", H5T_NATIVE_INTEGER, jsymSpaceID, jsymSetID, hdfError)
CALL h5sclose_f(jsymSpaceID,hdfError)
CALL io_write_integer3(jsymSetID,(/1,1,1/),dimsInt(:3),dos%jsym(:neigd,:,:))
CALL h5dclose_f(jsymSetID, hdfError)
dims(:3)=(/neigd,kpts%nkpt,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),ksymSpaceID,hdfError)
CALL h5dcreate_f(eigenvaluesGroupID, "ksym", H5T_NATIVE_INTEGER, ksymSpaceID, ksymSetID, hdfError)
CALL h5sclose_f(ksymSpaceID,hdfError)
CALL io_write_integer3(ksymSetID,(/1,1,1/),dimsInt(:3),dos%ksym(:neigd,:,:))
CALL h5dclose_f(ksymSetID, hdfError)
CALL h5gclose_f(eigenvaluesGroupID, hdfError)
INTEGER :: n
INTEGER(HID_T) :: BSGroupID,groupID
INTEGER :: hdfError
if (io_groupexists(fileID,name_of_dos)) THEN
call io_gopen(fileID,name_of_dos,groupID)
ELSE
call h5gcreate_f(fileID, name_of_dos, GroupID, hdfError)
endif
if (io_groupexists(GroupID,"BS")) THEN
call io_gopen(GroupID,"BS",BSgroupID)
ELSE
CALL h5gcreate_f(fileID, "BS", BSGroupID, hdfError)
endif
if (.not.io_dataexists(BSGroupID,"kpts")) call io_write_var(BSGroupID,"kpts",kpts%bk)
if (.not.io_dataexists(BSGroupID,"eigenvalues")) call io_write_var(BSGroupID,"eigenvalues",eig)
call io_write_var(BSGroupID,weight_name,weight_eig(:,:,:))
CALL h5gclose_f(BSGroupID, hdfError)
CALL h5gclose_f(GroupID, hdfError)
#if 1==2
IF (banddos%unfoldband) THEN
CALL h5gcreate_f(fileID, '/bandUnfolding', bandUnfoldingGroupID, hdfError)
......@@ -322,6 +278,34 @@ MODULE m_banddos_io
CALL h5gclose_f(bandUnfoldingGroupID, hdfError)
END IF
#endif
END SUBROUTINE
SUBROUTINE writedosData(fileID,name_of_dos,e_grid,weight_name,dos)
character(len=*),intent(in) :: name_of_dos
character(len=*),intent(in) :: weight_name
real,intent(in):: e_grid(:),dos(:,:)
INTEGER(HID_T), INTENT(IN) :: fileID
INTEGER :: n
INTEGER(HID_T) :: DOSGroupID,groupID
INTEGER :: hdfError
if (io_groupexists(fileID,name_of_dos)) THEN
call io_gopen(fileID,name_of_dos,groupID)
ELSE
call h5gcreate_f(fileID, name_of_dos, GroupID, hdfError)
endif
if (io_groupexists(groupID,"DOS")) then
call io_gopen(groupID,"DOS",DOSGroupID)
ELSE
CALL h5gcreate_f(GroupID, "DOS", DOSGroupID, hdfError)
endif
if (.not.io_dataexists(DOSGroupID,"energyGrid")) call io_write_var(DOSGroupID,"energyGrid",e_grid)
print *,name_of_dos,weight_name
call io_write_var(DOSGroupID,weight_name,dos(:,:))
CALL h5gclose_f(DOSGroupID, hdfError)
CALL h5gclose_f(GroupID, hdfError)
END SUBROUTINE
......
......@@ -259,7 +259,7 @@ CONTAINS
! -> Optional the LO-coefficients: aclo,bclo,enerlo,cclo,acnmt,bcnmt,ccnmt
IF (atoms%nlod.GE.1) THEN
n=atoms%nlod*atoms%ntype
n=atoms%nlod*atoms%ntype
ALLOCATE (r_b(n))
CALL MPI_ALLREDUCE(denCoeffs%aclo(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM, MPI_COMM_WORLD,ierr)
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%aclo(:,:,jspin), 1)
......@@ -349,7 +349,7 @@ CONTAINS
ENDIF
! -> Collect the noco staff:
! -> Collect the noco staff:
IF ( noco%l_noco .AND. jspin.EQ.1 ) THEN
n = stars%ng3
......
......@@ -119,6 +119,7 @@ SUBROUTINE dos_init(thisDOS,input,atoms,kpts,vacuum,eig)
INTEGER :: ntype,l,i,ind
character :: spdfg(0:4)=["s","p","d","f","g"]
thisDOS%name_of_dos="Local"
thisDOS%neq=atoms%neq
thisDOS%eig=eig
ALLOCATE(thisDOS%jsym(input%neig,kpts%nkpt,input%jspins))
......@@ -153,20 +154,20 @@ SUBROUTINE dos_init(thisDOS,input,atoms,kpts,vacuum,eig)
thisDOS%weight_names(ind)="VAC2"
do i=1,vacuum%layerd
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0)") "LAYER1:",i
write(thisDOS%weight_names(ind),"(a,i0)") "LAYER1-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0)") "LAYER2:",i
write(thisDOS%weight_names(ind),"(a,i0)") "LAYER2-",i
end do
DO l=1,vacuum%layerd
do i=1,vacuum%nstars
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC1):",l,"-",i
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC1)-",l,"-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC1):",l,"-",i
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC1)-",l,"-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC2):",l,"-",i
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "R(gVAC2)-",l,"-",i
ind=ind+1
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC2):",l,"-",i
write(thisDOS%weight_names(ind),"(a,i0,a,i0)") "I(gVAC2)-",l,"-",i
end do
end do
......
......@@ -104,22 +104,22 @@ wannier/wannier.F90
wannier/wann_orbcomp.f90
wannier/wann_postproc.F90
)
if(FLEUR_USE_WANN)
if(FLEUR_USE_WANN_EXTERNAL)
set(fleur_F90 ${fleur_F90}
external/wannier90/src/comms.F90