Commit de788077 authored by Matthias Redies's avatar Matthias Redies

fix bugs in broadcast & otherwise

parent 6b543aa2
......@@ -15,7 +15,7 @@ CONTAINS
#ifdef CPP_MPI
LOGICAL :: l_relcor
CHARACTER(len=100):: namex
INTEGER :: ierr,n,i(3)
INTEGER :: ierr,n,i(5)
INCLUDE 'mpif.h'
IF (mpi%isize==1) RETURN !nothing to be done with only one PE
......@@ -31,7 +31,7 @@ CONTAINS
END SELECT
END IF
CALL MPI_BCAST(n,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) THEN
IF (mpi%irank /= 0) THEN
IF (ALLOCATED(xcpot)) DEALLOCATE(xcpot)
!Now we know the types and can allocate on the other PE type dependend
SELECT CASE(n)
......@@ -54,16 +54,18 @@ CONTAINS
CALL MPI_BCAST(namex,4,MPI_CHARACTER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_relcor,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(n,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) CALL xcpot%init(namex(1:4),l_relcor,n)
IF (mpi%irank /= 0) CALL xcpot%init(namex(1:4),l_relcor,n)
CALL MPI_BCAST(xcpot%lda_atom,n,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
TYPE IS (t_xcpot_libxc)
IF (mpi%irank==0) THEN
i(1)=xcpot%jspins
i(2)=xcpot%func_id_x
i(3)=xcpot%func_id_c
i(1) = xcpot%jspins
i(2) = xcpot%func_vxc_id_x
i(3) = xcpot%func_vxc_id_c
i(4) = xcpot%func_exc_id_x
i(5) = xcpot%func_exc_id_c
ENDIF
CALL MPI_BCAST(i,3,MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank.NE.0) CALL xcpot%init(i(1),i(2),i(3))
CALL MPI_BCAST(i,size(i),MPI_INTEGER,0,mpi%mpi_comm,ierr)
IF (mpi%irank /= 0) CALL xcpot%init(i(1),i(2),i(3),i(4),i(5))
END SELECT
#endif
END SUBROUTINE mpi_bc_xcpot
......
......@@ -111,7 +111,10 @@ CONTAINS
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN):: xcpot
#ifdef CPP_LIBXC
xcpot_is_gga=ANY((/XC_FAMILY_GGA, XC_FAMILY_HYB_GGA/)==xc_f03_func_info_get_family(xcpot%xc_info_x))
TYPE(xc_f03_func_info_t) :: xc_info
xc_info = xc_f03_func_get_info(xcpot%exc_func_x)
xcpot_is_gga=ANY((/XC_FAMILY_GGA, XC_FAMILY_HYB_GGA/)==xc_f03_func_info_get_family(xc_info))
#else
xcpot_is_gga=.false.
#endif
......@@ -121,10 +124,12 @@ CONTAINS
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN):: xcpot
#ifdef CPP_LIBXC
xcpot_is_LDA= (XC_FAMILY_LDA==xc_f03_func_info_get_family(xcpot%xc_info_x))
TYPE(xc_f03_func_info_t) :: xc_info
xc_info = xc_f03_func_get_info(xcpot%exc_func_x)
xcpot_is_LDA= (XC_FAMILY_LDA==xc_f03_func_info_get_family(xc_info))
#else
xcpot_is_LDA=.false.
#endif
END FUNCTION xcpot_is_LDA
......@@ -207,65 +212,32 @@ CONTAINS
END SUBROUTINE xcpot_get_vxc
!***********************************************************************
SUBROUTINE xcpot_get_exc(xcpot,jspins,rh,exc,grad)
!***********************************************************************
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN) :: xcpot
INTEGER, INTENT (IN) :: jspins
REAL,INTENT (IN) :: rh(:,:) !points,spin
REAL, INTENT (OUT) :: exc(:) !points
! optional arguments for GGA
! optional arguments for GGA
TYPE(t_gradients),OPTIONAL,INTENT(IN)::grad
REAL :: excc(SIZE(exc))
#ifdef CPP_LIBXC
#ifdef CPP_LIBXC
IF (xcpot%is_gga()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
CALL xc_f03_gga_exc(xcpot%exc_func_x, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,exc)
IF (xcpot%func_vxc_id_c>0) THEN
IF (xcpot%func_exc_id_c>0) THEN
CALL xc_f03_gga_exc(xcpot%exc_func_c, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,excc)
exc=exc+excc
END IF
ELSE !LDA potentials
CALL xc_f03_lda_exc(xcpot%exc_func_x, SIZE(rh,1), TRANSPOSE(rh), exc)
IF (xcpot%func_vxc_id_c>0) THEN
IF (xcpot%func_exc_id_c>0) THEN
CALL xc_f03_lda_exc(xcpot%exc_func_c, SIZE(rh,1), TRANSPOSE(rh), excc)
exc=exc+excc
END IF
ENDIF
#endif
END SUBROUTINE xcpot_get_vxc
!***********************************************************************
SUBROUTINE xcpot_get_exc(xcpot,jspins,rh,exc,grad)
!***********************************************************************
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN) :: xcpot
INTEGER, INTENT (IN) :: jspins
REAL,INTENT (IN) :: rh(:,:) !points,spin
REAL, INTENT (OUT) :: exc(:) !points
! optional arguments for GGA
TYPE(t_gradients),OPTIONAL,INTENT(IN)::grad
REAL :: excc(SIZE(exc))
#ifdef CPP_LIBXC
IF (xcpot%is_gga()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
CALL xc_f03_gga_exc(xcpot%xc_func_x, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,exc)
IF (xcpot%func_id_c>0) THEN
CALL xc_f03_gga_exc(xcpot%xc_func_c, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,excc)
exc=exc+excc
END IF
ELSE !LDA potentials
CALL xc_f03_lda_exc(xcpot%xc_func_x, SIZE(rh,1), TRANSPOSE(rh), exc)
IF (xcpot%func_id_c>0) THEN
CALL xc_f03_lda_exc(xcpot%xc_func_c, SIZE(rh,1), TRANSPOSE(rh), excc)
exc=exc+excc
END IF
ENDIF
#endif
END SUBROUTINE xcpot_get_exc
......
......@@ -147,8 +147,9 @@ contains
! replace brillouin weights with auxillary weights
call calc_EnergyDen_auxillary_weights(eig_id, kpts, jspin, cdnvalJob%weights)
call cdnval(eig_id, mpi, kpts, jspin, noco, input, banddos, cell, atoms, enpara, stars, vacuum, dimension, &
sphhar, sym, vTot, oneD, cdnvalJob, EnergyDen, regCharges, dos, tmp_results, moments)
call cdnval(eig_id, mpi, kpts, jspin, noco, input, banddos, cell, atoms, &
enpara, stars, vacuum, dimension, sphhar, sym, vTot, oneD, cdnvalJob, &
EnergyDen, regCharges, dos, tmp_results, moments)
enddo
end subroutine calc_EnergyDen
......@@ -204,7 +205,7 @@ contains
!local vars
type(t_xcpot_libxc) ::aux_xcpot
type(t_gradients) :: tmp_grad
integer, parameter :: id_corr = 5, id_exch = 1
integer, parameter :: id_corr = 9, id_exch = 1
integer :: nsp, n
......@@ -228,9 +229,12 @@ contains
call init_mt_grid(nsp,input%jspins,atoms,sphhar,aux_xcpot,sym)
do n = 1,atoms%ntype
call mt_to_grid(aux_xcpot, input%jspins, atoms, sphhar, den%mt(:,0:,n,:), nsp, n, tmp_grad, den_RS%mt)
call mt_to_grid(aux_xcpot, input%jspins, atoms, sphhar, EnergyDen%mt(:,0:,n,:), nsp, n, tmp_grad, EnergyDen_RS%mt)
call mt_to_grid(aux_xcpot, input%jspins, atoms, sphhar, vTot%mt(:,0:,n,:), nsp, n, tmp_grad, vTot_RS%mt)
call mt_to_grid(aux_xcpot, input%jspins, atoms, sphhar, den%mt(:,0:,n,:), &
nsp, n, tmp_grad, den_RS%mt)
call mt_to_grid(aux_xcpot, input%jspins, atoms, sphhar, EnergyDen%mt(:,0:,n,:), &
nsp, n, tmp_grad, EnergyDen_RS%mt)
call mt_to_grid(aux_xcpot, input%jspins, atoms, sphhar, vTot%mt(:,0:,n,:), &
nsp, n, tmp_grad, vTot_RS%mt)
enddo
call finish_mt_grid()
......
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