Commit 2aa07066 authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' into MetaGGA

parents 59280e06 d8afa3fa
...@@ -44,7 +44,6 @@ CONTAINS ...@@ -44,7 +44,6 @@ CONTAINS
USE m_unfold_band_kpts !used for unfolding bands USE m_unfold_band_kpts !used for unfolding bands
USE m_types_mpimat USE m_types_mpimat
IMPLICIT NONE IMPLICIT NONE
TYPE(t_results),INTENT(INOUT):: results TYPE(t_results),INTENT(INOUT):: results
CLASS(t_xcpot),INTENT(IN) :: xcpot CLASS(t_xcpot),INTENT(IN) :: xcpot
...@@ -172,11 +171,6 @@ CONTAINS ...@@ -172,11 +171,6 @@ CONTAINS
l_wu=.FALSE. l_wu=.FALSE.
ne_all=DIMENSION%neigd ne_all=DIMENSION%neigd
if (allocated(zmat)) then
deallocate(zmat, stat=dealloc_stat, errmsg=errmsg)
if(dealloc_stat /= 0) call juDFT_error("deallocate failed for zmat",&
hint=errmsg, calledby="eigen.F90")
endif
!Try to symmetrize matrix !Try to symmetrize matrix
CALL symmetrize_matrix(mpi,noco,kpts,nk,hmat,smat) CALL symmetrize_matrix(mpi,noco,kpts,nk,hmat,smat)
...@@ -199,7 +193,9 @@ CONTAINS ...@@ -199,7 +193,9 @@ CONTAINS
END IF END IF
CALL eigen_diag(mpi,hmat,smat,nk,jsp,iter,ne_all,eig,zMat) CALL eigen_diag(mpi,hmat,smat,nk,jsp,iter,ne_all,eig,zMat)
CALL smat%free() CALL smat%free()
CALL hmat%free()
DEALLOCATE(hmat,smat, stat=dealloc_stat, errmsg=errmsg) DEALLOCATE(hmat,smat, stat=dealloc_stat, errmsg=errmsg)
if(dealloc_stat /= 0) call juDFT_error("deallocate failed for hmat or smat",& if(dealloc_stat /= 0) call juDFT_error("deallocate failed for hmat or smat",&
hint=errmsg, calledby="eigen.F90") hint=errmsg, calledby="eigen.F90")
...@@ -214,11 +210,11 @@ CONTAINS ...@@ -214,11 +210,11 @@ CONTAINS
#else #else
ne_found=ne_all ne_found=ne_all
#endif #endif
IF (.NOT.zmat%l_real) THEN IF (.NOT.zMat%l_real) THEN
zMat%data_c(:lapw%nmat,:ne_found) = CONJG(zMat%data_c(:lapw%nmat,:ne_found)) zMat%data_c(:lapw%nmat,:ne_found) = CONJG(zMat%data_c(:lapw%nmat,:ne_found))
END IF END IF
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,& CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,&
eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat) eig(:ne_found),n_start=mpi%n_size,n_end=mpi%n_rank,zMat=zMat)
neigBuffer(nk,jsp) = ne_found neigBuffer(nk,jsp) = ne_found
#if defined(CPP_MPI) #if defined(CPP_MPI)
! RMA synchronization ! RMA synchronization
...@@ -228,11 +224,14 @@ CONTAINS ...@@ -228,11 +224,14 @@ CONTAINS
IF (banddos%unfoldband) THEN IF (banddos%unfoldband) THEN
CALL calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,nk,jsp,eig,results,input,atoms,unfoldingBuffer,mpi) CALL calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,nk,jsp,eig,results,input,atoms,unfoldingBuffer,mpi)
CALL smat_unfold%free()
DEALLOCATE(smat_unfold, stat=dealloc_stat, errmsg=errmsg) DEALLOCATE(smat_unfold, stat=dealloc_stat, errmsg=errmsg)
if(dealloc_stat /= 0) call juDFT_error("deallocate failed for smat_unfold",& if(dealloc_stat /= 0) call juDFT_error("deallocate failed for smat_unfold",&
hint=errmsg, calledby="eigen.F90") hint=errmsg, calledby="eigen.F90")
END IF END IF
call zMat%free()
deallocate(zMat)
END DO k_loop END DO k_loop
END DO ! spin loop ends END DO ! spin loop ends
...@@ -241,7 +240,7 @@ CONTAINS ...@@ -241,7 +240,7 @@ CONTAINS
results%unfolding_weights = CMPLX(0.0,0.0) results%unfolding_weights = CMPLX(0.0,0.0)
CALL MPI_ALLREDUCE(unfoldingBuffer,results%unfolding_weights,SIZE(results%unfolding_weights,1)*SIZE(results%unfolding_weights,2)*SIZE(results%unfolding_weights,3),CPP_MPI_COMPLEX,MPI_SUM,mpi%mpi_comm,ierr) CALL MPI_ALLREDUCE(unfoldingBuffer,results%unfolding_weights,SIZE(results%unfolding_weights,1)*SIZE(results%unfolding_weights,2)*SIZE(results%unfolding_weights,3),CPP_MPI_COMPLEX,MPI_SUM,mpi%mpi_comm,ierr)
END IF END IF
CALL MPI_ALLREDUCE(neigBuffer,results%neig,kpts%nkpt*input%jspins,MPI_INTEGER,MPI_SUM,mpi%sub_comm,ierr) CALL MPI_ALLREDUCE(neigBuffer,results%neig,kpts%nkpt*input%jspins,MPI_INTEGER,MPI_SUM,mpi%mpi_comm,ierr)
CALL MPI_BARRIER(mpi%MPI_COMM,ierr) CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#else #else
results%neig(:,:) = neigBuffer(:,:) results%neig(:,:) = neigBuffer(:,:)
......
...@@ -27,7 +27,7 @@ MODULE m_banddos_io ...@@ -27,7 +27,7 @@ MODULE m_banddos_io
CONTAINS CONTAINS
SUBROUTINE openBandDOSFile(fileID, input, atoms, cell, kpts) SUBROUTINE openBandDOSFile(fileID, input, atoms, cell, kpts, banddos)
USE m_types USE m_types
USE hdf5 USE hdf5
...@@ -37,6 +37,7 @@ MODULE m_banddos_io ...@@ -37,6 +37,7 @@ MODULE m_banddos_io
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_banddos), INTENT(IN) :: banddos
INTEGER(HID_T), INTENT(OUT) :: fileID INTEGER(HID_T), INTENT(OUT) :: fileID
...@@ -67,6 +68,7 @@ MODULE m_banddos_io ...@@ -67,6 +68,7 @@ MODULE m_banddos_io
INTEGER :: hdfError, dimsInt(7) INTEGER :: hdfError, dimsInt(7)
INTEGER :: version INTEGER :: version
INTEGER :: fakeLogical
REAL :: eFermiPrev REAL :: eFermiPrev
LOGICAL :: l_error LOGICAL :: l_error
...@@ -98,6 +100,9 @@ MODULE m_banddos_io ...@@ -98,6 +100,9 @@ MODULE m_banddos_io
CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError) CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError)
CALL io_write_attint0(generalGroupID,'spins',input%jspins) CALL io_write_attint0(generalGroupID,'spins',input%jspins)
CALL io_write_attreal0(generalGroupID,'lastFermiEnergy',eFermiPrev) CALL io_write_attreal0(generalGroupID,'lastFermiEnergy',eFermiPrev)
fakeLogical = 0
IF (banddos%unfoldband) fakeLogical = 1
CALL io_write_attint0(generalGroupID,'bandUnfolding',fakeLogical)
CALL h5gclose_f(generalGroupID, hdfError) CALL h5gclose_f(generalGroupID, hdfError)
CALL h5gcreate_f(fileID, '/cell', cellGroupID, hdfError) CALL h5gcreate_f(fileID, '/cell', cellGroupID, hdfError)
...@@ -236,12 +241,14 @@ MODULE m_banddos_io ...@@ -236,12 +241,14 @@ MODULE m_banddos_io
INTEGER(HID_T), INTENT(IN) :: fileID INTEGER(HID_T), INTENT(IN) :: fileID
INTEGER(HID_T) :: eigenvaluesGroupID INTEGER(HID_T) :: eigenvaluesGroupID
INTEGER(HID_T) :: bandUnfoldingGroupID
INTEGER(HID_T) :: eigenvaluesSpaceID, eigenvaluesSetID INTEGER(HID_T) :: eigenvaluesSpaceID, eigenvaluesSetID
INTEGER(HID_T) :: numFoundEigsSpaceID, numFoundEigsSetID INTEGER(HID_T) :: numFoundEigsSpaceID, numFoundEigsSetID
INTEGER(HID_T) :: lLikeChargeSpaceID, lLikeChargeSetID INTEGER(HID_T) :: lLikeChargeSpaceID, lLikeChargeSetID
INTEGER(HID_T) :: jsymSpaceID, jsymSetID INTEGER(HID_T) :: jsymSpaceID, jsymSetID
INTEGER(HID_T) :: ksymSpaceID, ksymSetID INTEGER(HID_T) :: ksymSpaceID, ksymSetID
INTEGER(HID_T) :: bUWeightsSpaceID, bUWeightsSetID
INTEGER :: hdfError, dimsInt(7) INTEGER :: hdfError, dimsInt(7)
...@@ -296,6 +303,20 @@ MODULE m_banddos_io ...@@ -296,6 +303,20 @@ MODULE m_banddos_io
CALL h5gclose_f(eigenvaluesGroupID, hdfError) CALL h5gclose_f(eigenvaluesGroupID, hdfError)
IF (banddos%unfoldband) THEN
CALL h5gcreate_f(fileID, '/bandUnfolding', bandUnfoldingGroupID, hdfError)
dims(:3)=(/neigd,kpts%nkpt,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),bUWeightsSpaceID,hdfError)
CALL h5dcreate_f(bandUnfoldingGroupID, "weights", H5T_NATIVE_DOUBLE, bUWeightsSpaceID, buWeightsSetID, hdfError)
CALL h5sclose_f(bUWeightsSpaceID,hdfError)
CALL io_write_real3(bUWeightsSetID,(/1,1,1/),dimsInt(:3), REAL(results%unfolding_weights(:neigd,:,:)))
CALL h5dclose_f(bUWeightsSetID, hdfError)
CALL h5gclose_f(bandUnfoldingGroupID, hdfError)
END IF
END SUBROUTINE END SUBROUTINE
SUBROUTINE io_write_string1(datasetID,dims,stringLength,dataArray) SUBROUTINE io_write_string1(datasetID,dims,stringLength,dataArray)
......
...@@ -209,8 +209,10 @@ CONTAINS ...@@ -209,8 +209,10 @@ CONTAINS
LOGICAL :: write_to_file=.false. LOGICAL :: write_to_file=.false.
CLASS(t_mat), ALLOCATABLE :: zMat_s CLASS(t_mat), ALLOCATABLE :: zMat_s
CALL build_primitive_cell(banddos,p_cell,cell) ! method_rubel=.true. !this switch is to switch between overlap matrix and rubel method (without overlap matrix)
CALL build_primitive_cell(banddos,p_cell,cell)
IF (.not. method_rubel) THEN
DO j = 1, lapw%nv(jsp) DO j = 1, lapw%nv(jsp)
DO i = 1, j-1 DO i = 1, j-1
IF(smat_unfold%l_real) THEN IF(smat_unfold%l_real) THEN
...@@ -220,6 +222,7 @@ CONTAINS ...@@ -220,6 +222,7 @@ CONTAINS
END IF END IF
END DO END DO
END DO END DO
END IF
! write_to_file=.true. ! write_to_file=.true.
IF (write_to_file) THEN IF (write_to_file) THEN
IF (i_kpt==1) THEN IF (i_kpt==1) THEN
...@@ -233,7 +236,6 @@ CONTAINS ...@@ -233,7 +236,6 @@ CONTAINS
! write(222,'(234f15.8)') zMat%data_r ! write(222,'(234f15.8)') zMat%data_r
! write(223,'(234f15.8)') smat_unfold%data_r ! write(223,'(234f15.8)') smat_unfold%data_r
! method_rubel=.true. !this switch is to switch between overlap matrix and rubel method (without overlap matrix)
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
ALLOCATE(w_n(zMat%matsize2)) ALLOCATE(w_n(zMat%matsize2))
......
...@@ -127,7 +127,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -127,7 +127,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL write_band_sc(kpts,results,eFermiPrev) CALL write_band_sc(kpts,results,eFermiPrev)
END IF END IF
#ifdef CPP_HDF #ifdef CPP_HDF
CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts) CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts,banddos)
CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum) CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
CALL closeBandDOSFile(banddosFile_id) CALL closeBandDOSFile(banddosFile_id)
#endif #endif
......
...@@ -46,7 +46,7 @@ MODULE m_types_mpimat ...@@ -46,7 +46,7 @@ MODULE m_types_mpimat
PROCEDURE,PASS :: generate_full_matrix ! construct full matrix if only upper triangle of hermitian matrix is given PROCEDURE,PASS :: generate_full_matrix ! construct full matrix if only upper triangle of hermitian matrix is given
PROCEDURE,PASS :: print_matrix PROCEDURE,PASS :: print_matrix
PROCEDURE,PASS :: from_non_dist PROCEDURE,PASS :: from_non_dist
FINAL :: finalize FINAL :: finalize, finalize_1d, finalize_2d, finalize_3d
END TYPE t_mpimat END TYPE t_mpimat
PUBLIC t_mpimat PUBLIC t_mpimat
...@@ -295,6 +295,44 @@ CONTAINS ...@@ -295,6 +295,44 @@ CONTAINS
CALL mpimat_free(mat) CALL mpimat_free(mat)
END SUBROUTINE finalize END SUBROUTINE finalize
SUBROUTINE finalize_1d(mat)
IMPLICIT NONE
TYPE(t_mpimat),INTENT(INOUT) :: mat(:)
INTEGER :: i
DO i = 1,size(mat)
CALL mpimat_free(mat(i))
ENDDO
END SUBROUTINE finalize_1d
SUBROUTINE finalize_2d(mat)
IMPLICIT NONE
TYPE(t_mpimat),INTENT(INOUT) :: mat(:,:)
INTEGER :: i,j
DO i = 1,size(mat, dim=1)
DO j = 1,size(mat, dim=2)
CALL mpimat_free(mat(i,j))
ENDDO
ENDDO
END SUBROUTINE finalize_2d
SUBROUTINE finalize_3d(mat)
IMPLICIT NONE
TYPE(t_mpimat),INTENT(INOUT) :: mat(:,:,:)
INTEGER :: i,j,k
DO i = 1,size(mat, dim=1)
DO j = 1,size(mat, dim=2)
DO k = 1,size(mat, dim=3)
CALL mpimat_free(mat(i,j,k))
ENDDO
ENDDO
ENDDO
END SUBROUTINE finalize_3d
SUBROUTINE mpimat_free(mat) SUBROUTINE mpimat_free(mat)
IMPLICIT NONE IMPLICIT NONE
CLASS(t_mpimat),INTENT(INOUT) :: mat CLASS(t_mpimat),INTENT(INOUT) :: mat
...@@ -370,8 +408,10 @@ CONTAINS ...@@ -370,8 +408,10 @@ CONTAINS
mat%blacsdata%blacs_desc(4)=global_size2 mat%blacsdata%blacs_desc(4)=global_size2
mat%global_size1=global_size1 mat%global_size1=global_size1
mat%global_size2=global_size2 mat%global_size2=global_size2
#ifdef CPP_SCALAPACK
mat%matsize1=NUMROC( global_size1,mat%blacsdata%blacs_desc(5), mat%blacsdata%myrow, mat%blacsdata%blacs_desc(7), mat%blacsdata%nprow ) mat%matsize1=NUMROC( global_size1,mat%blacsdata%blacs_desc(5), mat%blacsdata%myrow, mat%blacsdata%blacs_desc(7), mat%blacsdata%nprow )
mat%matsize1=NUMROC( global_size2,mat%blacsdata%blacs_desc(6), mat%blacsdata%mycol, mat%blacsdata%blacs_desc(8), mat%blacsdata%npcol ) mat%matsize1=NUMROC( global_size2,mat%blacsdata%blacs_desc(6), mat%blacsdata%mycol, mat%blacsdata%blacs_desc(8), mat%blacsdata%npcol )
#endif
ELSE ELSE
mat%matsize1=templ%matsize1 mat%matsize1=templ%matsize1
mat%matsize2=templ%matsize2 mat%matsize2=templ%matsize2
...@@ -467,12 +507,12 @@ CONTAINS ...@@ -467,12 +507,12 @@ CONTAINS
k = k + 1 k = k + 1
ENDDO ENDDO
ENDDO ENDDO
#ifdef CPP_BLACSDEFAULT !#ifdef CPP_BLACSDEFAULT
!Get the Blacs default context !Get the Blacs default context
CALL BLACS_GET(0,0,ictextblacs) CALL BLACS_GET(0,0,ictextblacs)
#else !#else
ictextblacs=mpi_subcom ! ictextblacs=mpi_subcom
#endif !#endif
! Create the Grid ! Create the Grid
CALL BLACS_GRIDMAP(ictextblacs,iusermap,size(iusermap,1),blacsdata%nprow,blacsdata%npcol) CALL BLACS_GRIDMAP(ictextblacs,iusermap,size(iusermap,1),blacsdata%nprow,blacsdata%npcol)
! Now control, whether the BLACS grid is the one we wanted ! Now control, whether the BLACS grid is the one we wanted
......
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