Commit 7c453ce5 authored by Daniel Wortmann's avatar Daniel Wortmann

Many fixes to be able to compile after merge

parent 0e969444
......@@ -19,8 +19,8 @@ USE m_polangle
CONTAINS
SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
,sym,oneD,cell,noco,input,atoms,den)
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_atoms), INTENT(INOUT) :: atoms
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
......@@ -30,7 +30,7 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden), INTENT(INOUT) :: den
REAL :: moments(atoms%ntype,3)
REAL :: moments(3,atoms%ntype)
REAL :: phiTemp(atoms%ntype),thetaTemp(atoms%ntype),pi
INTEGER :: i
pi=pimach()
......@@ -39,7 +39,7 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
phiTemp=noco%alph
thetaTemp=noco%beta
CALL magnMomFromDen(input,atoms,noco,den,moments)
CALL magnMomFromDen(input,atoms,noco,den,moments,thetaTemp,phiTemp)
! DO i=1, atoms%ntype
! IF (abs(atoms%theta_mt_avg(i)).LE. 0.001) THEN
! atoms%phi_mt_avg(i)=0.0
......@@ -54,7 +54,7 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
!write(*,*) moments(2,1)
!write(*,*) "mz2"
!write(*,*) moments(2,3)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,-atoms%phi_mt_avg,-atoms%theta_mt_avg,den)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,-phiTemp,-thetaTemp,den)
!write (*,*)"mx my mz"
!CALL sphericaltocart(SQRT(moments(1,1)**2+moments(1,2)**2+moments(1,3)**2),thetaTemp(1),phiTemp(1),x,y,z)
!write(*,*) x,y,z
......@@ -64,10 +64,8 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
!!write(*,*) atoms%phi_mt_avg
!write(*,*) "atoms%theta_mt_avg"
!write(*,*) atoms%theta_mt_avg
noco%alph=mod(atoms%phi_mt_avg+phiTemp,2*pimach())
noco%beta=mod(atoms%theta_mt_avg+thetaTemp,2*pimach())
atoms%phi_mt_avg=noco%alph
atoms%theta_mt_avg=noco%beta
noco%alph=mod(noco%alph+phiTemp,2*pimach())
noco%beta=mod(noco%alph+thetaTemp,2*pimach())
DO i=1, atoms%ntype
IF(noco%alph(i)<0) noco%alph(i)=noco%alph(i)+2*pi
......@@ -90,8 +88,8 @@ END SUBROUTINE rotateMagnetToSpinAxis
SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars&
,sym,oneD,cell,input,atoms,den,inDen)
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_atoms), INTENT(INOUT) :: atoms
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
......@@ -102,11 +100,9 @@ SUBROUTINE rotateMagnetFromSpinAxis(noco,vacuum,sphhar,stars&
TYPE(t_potden), INTENT(INOUT) :: den, inDen
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,atoms%phi_mt_avg,atoms%theta_mt_avg,den)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,atoms%phi_mt_avg,atoms%theta_mt_avg,inDen)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,noco%alph,noco%beta,den)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,noco%alph,noco%beta,inDen)
atoms%flipSpinPhi=0
atoms%flipSpinTheta=0
noco%alph=0
noco%beta=0
......@@ -114,4 +110,3 @@ END SUBROUTINE rotateMagnetFromSpinAxis
END MODULE m_alignSpinAxisMagn
......@@ -15,7 +15,7 @@ CONTAINS
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles)
SUBROUTINE magDiMom(sym,input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles)
USE m_constants
USE m_types
......@@ -26,7 +26,7 @@ SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles)
USE m_intgr
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
......@@ -64,7 +64,7 @@ SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles)
inRho(:,:,iType,4) = inRho(:,:,iType,2) * COS(theta)
inRho(:,:,iType,2) = inRho(:,:,iType,2) * COS(phi)*SIN(theta)
ELSE
DO ilh = 0,sphhar%nlh(atoms%ntypsy(iType))
DO ilh = 0,sphhar%nlh(sym%ntypsy(iType))
DO i = 1,atoms%jri(iType)
cdn11 = rho(i,ilh,iType,1)
......@@ -89,7 +89,7 @@ SUBROUTINE magDiMom(input,atoms,sphhar,noco,l_fmpl2,rho,magDipoles,elecDipoles)
rhoSphHarms = CMPLX(0.0,0.0)
DO i = 1, 4
DO iType = 1, atoms%ntype
CALL lattHarmsRepToSphHarms(atoms,sphhar,iType,inRho(:,0:,iType,i),rhoSphHarms(:,:,iType,i))
CALL lattHarmsRepToSphHarms(sym,atoms,sphhar,iType,inRho(:,0:,iType,i),rhoSphHarms(:,:,iType,i))
END DO
END DO
......
......@@ -11,7 +11,7 @@
MODULE m_magnMomFromDen
CONTAINS
SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments,theta_mt_avg,phi_mt_avg)
USE m_constants
USE m_types
USE m_intgr
......@@ -21,10 +21,12 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(INOUT) :: atoms
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden),INTENT(IN) :: den
REAL, INTENT(OUT) :: moments(atoms%ntype,3)
REAL, INTENT(OUT) :: moments(3,atoms%ntype)
REAL,INTENT(OUT) :: theta_mt_avg(atoms%ntype)
REAL,INTENT(OUT) :: phi_mt_avg(atoms%ntype)
INTEGER :: jsp,i,j
REAL :: mx,my,mz
......@@ -50,19 +52,19 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
!!Assign results
DO i=1 , atoms%ntype
IF (noco%l_mtNocoPot) THEN
moments(i,1:2)=2*dummyResults(i,3:4)
moments(1:2,i)=2*dummyResults(i,3:4)
END IF
moments(i,3)=dummyResults(i,1)-dummyResults(i,2)
moments(3,i)=dummyResults(i,1)-dummyResults(i,2)
END DO
DEALLOCATE(dummyResults)
!!Calculation of Angles
DO i=1 , atoms%ntype
mx=moments(i,1)
my=moments(i,2)
mz=moments(i,3)
CALL pol_angle(mx,my,mz,atoms%theta_mt_avg(i),atoms%phi_mt_avg(i))
IF(mx<0) atoms%theta_mt_avg(i)=-atoms%theta_mt_avg(i)
mx=moments(1,i)
my=moments(2,i)
mz=moments(3,i)
CALL pol_angle(mx,my,mz,theta_mt_avg(i),phi_mt_avg(i))
IF(mx<0) theta_mt_avg(i)=-theta_mt_avg(i)
ENDDO
END SUBROUTINE magnMomFromDen
......
......@@ -16,7 +16,7 @@ CONTAINS
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes)
SUBROUTINE resMoms(sym,input,atoms,sphhar,noco,den,rhoLRes)
USE m_constants
USE m_types
......@@ -24,7 +24,7 @@ SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes)
USE m_magDiMom
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
......@@ -61,7 +61,7 @@ SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes)
! WRITE(5000,'(f15.8)') den%mt(:,:,:,4)
END IF
CALL magDiMom(input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,t_op,elecDip)
CALL magDiMom(sym,input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,t_op,elecDip)
DO l = 0, atoms%lmaxd
DO lp = 0, l
......@@ -71,7 +71,7 @@ SUBROUTINE resMoms(input,atoms,sphhar,noco,den,rhoLRes)
rhoTemp(:,:,:,2) = rhoLRes(:,:,llp,:,2)
rhoTemp(:,:,:,3) = rhoLRes(:,:,llp,:,3)
rhoTemp(:,:,:,4) = rhoLRes(:,:,llp,:,4)
CALL magDiMom(input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,res_T_op(:,:,llp),resElecDip(:,:,llp))
CALL magDiMom(sym,input,atoms,sphhar,noco,noco%l_mperp,rhoTemp,res_T_op(:,:,llp),resElecDip(:,:,llp))
END DO
END DO
......
......@@ -13,7 +13,7 @@ MODULE m_rhosphnlo
!***********************************************************************
CONTAINS
SUBROUTINE rhosphnlo(itype,atoms,sphhar,sym, uloulopn,dulon,uulon,&
ello,vr, aclo,bclo,cclo,acnmt,bcnmt,ccnmt,f,g, rho,qmtllo)
ello,vr, aclo,bclo,cclo,acnmt,bcnmt,ccnmt,f,g, rho,rholres,qmtllo)
USE m_constants, ONLY : c_light,sfp_const
USE m_radsra
......
......@@ -19,7 +19,7 @@ CONTAINS
!> The matrices generated and diagonalized here are of type m_mat as defined in m_types_mat.
!>@author D. Wortmann
SUBROUTINE eigen(mpi,stars,sphhar,atoms,xcpot,sym,kpts,vacuum,input,&
cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inden,v,vx)
cell,enpara,banddos,noco,oneD,mpbasis,hybrid,iter,eig_id,results,inden,v,vx)
#include"cpp_double.h"
USE m_types
......@@ -158,7 +158,7 @@ CONTAINS
IF (hybrid%l_addhf) CALL add_Vnonlocal(nk,lapw,atoms,hybrid,input,kpts,jsp,results,xcpot,noco,hmat)
IF(hybrid%l_subvxc) THEN
CALL subvxc(lapw,kpts%bk(:,nk),input,jsp,v%mt(:,0,:,:),atoms,ud,hybrid,enpara%el0,enpara%ello0,&
CALL subvxc(lapw,kpts%bk(:,nk),input,jsp,v%mt(:,0,:,:),atoms,ud,mpbasis,hybrid,enpara%el0,enpara%ello0,&
sym,cell,sphhar,stars,xcpot,mpi,oneD,hmat,vx)
END IF
END IF ! hybrid%l_hybrid
......
......@@ -264,7 +264,7 @@ CONTAINS
IF (mpi%irank.EQ.0) CALL writeXMLElement('FermiEnergy',(/'value','units'/),attributes(1:2))
ENDIF
IF(.not.input%eig66(1))THEN
!IF(.not.input%eig66(1))THEN
!Put w_iks into eig-file
DO jsp = 1,nspins
DO k = 1,kpts%nkpt
......@@ -274,7 +274,7 @@ CONTAINS
#endif
ENDDO
ENDDO
ENDIF
!ENDIF
RETURN
8020 FORMAT (/,'FERMIE:',/,&
......
......@@ -19,6 +19,7 @@ MODULE m_constants
INTEGER, PARAMETER :: coreState_const = 1
INTEGER, PARAMETER :: valenceState_const = 2
INTEGER, PARAMETER :: lmaxU_const = 3
COMPLEX, PARAMETER :: cmplx_0=(0.0,0.0)
REAL, PARAMETER :: pi_const=3.1415926535897932
REAL, PARAMETER :: tpi_const=2.*3.1415926535897932
REAL, PARAMETER :: fpi_const=4.*3.1415926535897932
......@@ -38,6 +39,17 @@ MODULE m_constants
INTEGER, PARAMETER :: POTDEN_TYPE_EnergyDen = 5
INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density
INTEGER, PARAMETER :: PLOT_INPDEN=1
INTEGER, PARAMETER :: PLOT_OUTDEN_Y_CORE=2
INTEGER, PARAMETER :: PLOT_INPDEN_N_CORE=3
INTEGER, PARAMETER :: PLOT_MIXDEN_Y_CORE=4
INTEGER, PARAMETER :: PLOT_MIXDEN_N_CORE=5
INTEGER, PARAMETER :: PLOT_POT_TOT=7
INTEGER, PARAMETER :: PLOT_POT_EXT=8
INTEGER, PARAMETER :: PLOT_POT_COU=9
INTEGER, PARAMETER :: PLOT_POT_VXC=10
CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/&
'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',&
'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',&
......
......@@ -96,7 +96,14 @@ MODULE m_types_atoms
!lda_u information(ntype)
TYPE(t_utype), ALLOCATABLE::lda_u(:)
INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype)
INTEGER, ALLOCATABLE :: nflip(:) !<flip magnetisation of this atom
!flipSpinTheta and flipSpinPhi are the angles which are given
!in the input to rotate the charge den by these polar angles.
!Typical one needs ntype angles.
REAL, ALLOCATABLE :: flipSpinPhi(:)
REAL, ALLOCATABLE :: flipSpinTheta(:)
!Logical switch which decides if the rotated cdn should be scaled.
!Yet untested feature.
LOGICAL, ALLOCATABLE :: flipSpinScale(:)
CONTAINS
PROCEDURE :: init=>init_atoms
PROCEDURE :: nsp => calc_nsp_atom
......@@ -158,7 +165,9 @@ MODULE m_types_atoms
call mpi_bc(this%krla,rank,mpi_comm)
call mpi_bc(this%relcor,rank,mpi_comm)
call mpi_bc(this%relax,rank,mpi_comm)
call mpi_bc(this%nflip,rank,mpi_comm)
call mpi_bc(this%flipSpinPhi,rank,mpi_comm)
call mpi_bc(this%flipSpinTheta,rank,mpi_comm)
call mpi_bc(this%flipSpinScale,rank,mpi_comm)
#ifdef CPP_MPI
CALL mpi_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -236,7 +245,9 @@ MODULE m_types_atoms
ALLOCATE(this%lmax(this%ntype))
ALLOCATE(this%nlo(this%ntype))
ALLOCATE(this%lnonsph(this%ntype))
ALLOCATE(this%nflip(this%ntype))
ALLOCATE(this%flipSpinPhi(this%ntype))
ALLOCATE(this%flipSpinTheta(this%ntype))
ALLOCATE(this%flipSpinScale(this%ntype))
ALLOCATE(this%l_geo(this%ntype))
ALLOCATE(this%lda_u(4*this%ntype))
ALLOCATE(this%bmu(this%ntype))
......@@ -271,12 +282,10 @@ MODULE m_types_atoms
this%zatom(n) = 1.0e-10
END IF
this%zatom(n) = this%nz(n)
this%flipSpinPhi(n) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPaths))//'/@flipSpinPhi'))
this%flipSpinTheta(n) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xpaths))//'/@flipSpinTheta'))
this%flipSpinScale(n) = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xpaths))//'/@flipSpinScale'))
IF (evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPaths))//'/@flipSpin'))) THEN
this%nflip(n) = 1
ELSE
this%nflip(n) = 0
ENDIF
this%bmu(n) = evaluateFirstOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPaths))//'/@magMom'))
!Now the xml elements
!mtSphere
......
......@@ -15,38 +15,25 @@ MODULE m_types_hybrid
LOGICAL :: l_subvxc = .false.
LOGICAL :: l_calhf = .false.
LOGICAL :: l_addhf = .false.
INTEGER :: ewaldlambda =3
INTEGER :: lexp =16
INTEGER :: ewaldlambda
INTEGER :: lexp = 0
INTEGER :: bands1 !Only read in
INTEGER :: nbasp
INTEGER :: maxlcutm1
INTEGER :: maxindxm1
INTEGER :: maxbasm1
INTEGER :: maxindxp1
INTEGER :: maxgptm
INTEGER :: maxgptm1
INTEGER :: maxindx
INTEGER :: max_indx_p_1 !new
INTEGER :: maxlmindx
INTEGER :: gptmd
INTEGER, ALLOCATABLE :: nindx(:, :)
INTEGER, ALLOCATABLE :: select1(:, :)
INTEGER, ALLOCATABLE :: select1(:,:)
INTEGER, ALLOCATABLE :: lcutm1(:)
INTEGER, ALLOCATABLE :: nindxm1(:, :)
INTEGER, ALLOCATABLE :: gptm(:, :)
INTEGER, ALLOCATABLE :: ngptm1(:)
INTEGER, ALLOCATABLE :: pgptm1(:, :)
INTEGER, ALLOCATABLE :: ngptm(:)
INTEGER, ALLOCATABLE :: pgptm(:, :)
INTEGER, ALLOCATABLE :: lcutwf(:)
INTEGER, ALLOCATABLE :: map(:, :)
INTEGER, ALLOCATABLE :: tvec(:, :, :)
INTEGER, ALLOCATABLE :: map(:,:)
INTEGER, ALLOCATABLE :: tvec(:,:,:)
INTEGER, ALLOCATABLE :: nbasm(:)
REAL :: gcutm1
REAL :: tolerance1 = 1e-4 !only read in
REAL, ALLOCATABLE :: basm1(:, :, :, :)
COMPLEX, ALLOCATABLE :: d_wgn2(:, :, :, :)
INTEGER, ALLOCATABLE :: ne_eig(:), nbands(:), nobd(:) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: div_vv(:, :, :)
!REAL, ALLOCATABLE :: radbasfn_mt(:,:,:,:)
COMPLEX, ALLOCATABLE :: d_wgn2(:,:,:,:)
INTEGER, ALLOCATABLE :: ne_eig(:)
INTEGER, ALLOCATABLE :: nbands(:)
INTEGER, ALLOCATABLE :: nobd(:,:)
REAL, ALLOCATABLE :: div_vv(:,:,:)
CONTAINS
PROCEDURE :: read_xml =>read_xml_hybrid
PROCEDURE :: mpi_bc =>mpi_bc_hybrid
......@@ -74,31 +61,32 @@ MODULE m_types_hybrid
CALL mpi_bc(this%lexp ,rank,mpi_comm)
CALL mpi_bc(this%bands1,rank,mpi_comm)
CALL mpi_bc(this%nbasp,rank,mpi_comm)
CALL mpi_bc(this%maxlcutm1,rank,mpi_comm)
CALL mpi_bc(this%maxindxm1,rank,mpi_comm)
!CALL mpi_bc(this%maxlcutm1,rank,mpi_comm)
!CALL mpi_bc(this%maxindxm1,rank,mpi_comm)
CALL mpi_bc(this%maxbasm1,rank,mpi_comm)
CALL mpi_bc(this%maxindxp1,rank,mpi_comm)
CALL mpi_bc(this%maxgptm,rank,mpi_comm)
CALL mpi_bc(this%maxgptm1,rank,mpi_comm)
CALL mpi_bc(this%maxindx,rank,mpi_comm)
CALL mpi_bc(this%max_indx_p_1,rank,mpi_comm)
!CALL mpi_bc(this%maxindxp1,rank,mpi_comm)
!CALL mpi_bc(this%maxgptm,rank,mpi_comm)
!CALL mpi_bc(this%maxgptm1,rank,mpi_comm)
!CALL mpi_bc(this%maxindx,rank,mpi_comm)
CALL mpi_bc(this%maxlmindx,rank,mpi_comm)
CALL mpi_bc(this%gptmd,rank,mpi_comm)
CALL mpi_bc(this%nindx,rank,mpi_comm)
!CALL mpi_bc(this%gptmd,rank,mpi_comm)
!CALL mpi_bc(this%nindx,rank,mpi_comm)
CALL mpi_bc(this%select1,rank,mpi_comm)
CALL mpi_bc(this%lcutm1,rank,mpi_comm)
CALL mpi_bc(this%nindxm1,rank,mpi_comm)
CALL mpi_bc(this%gptm,rank,mpi_comm)
CALL mpi_bc(this%ngptm1,rank,mpi_comm)
CALL mpi_bc(this%pgptm1,rank,mpi_comm)
CALL mpi_bc(this%ngptm,rank,mpi_comm)
CALL mpi_bc(this%pgptm,rank,mpi_comm)
!CALL mpi_bc(this%nindxm1,rank,mpi_comm)
!CALL mpi_bc(this%gptm,rank,mpi_comm)
!CALL mpi_bc(this%ngptm1,rank,mpi_comm)
!CALL mpi_bc(this%pgptm1,rank,mpi_comm)
!CALL mpi_bc(this%ngptm,rank,mpi_comm)
!CALL mpi_bc(this%pgptm,rank,mpi_comm)
CALL mpi_bc(this%lcutwf,rank,mpi_comm)
CALL mpi_bc(this%map,rank,mpi_comm)
CALL mpi_bc(this%tvec,rank,mpi_comm)
CALL mpi_bc(this%nbasm,rank,mpi_comm)
CALL mpi_bc(this%gcutm1,rank,mpi_comm)
CALL mpi_bc(this%tolerance1 ,rank,mpi_comm)
CALL mpi_bc(this%basm1,rank,mpi_comm)
!CALL mpi_bc(this%gcutm1,rank,mpi_comm)
!CALL mpi_bc(this%tolerance1 ,rank,mpi_comm)
!CALL mpi_bc(this%basm1,rank,mpi_comm)
CALL mpi_bc(this%d_wgn2,rank,mpi_comm)
CALL mpi_bc(this%ne_eig,rank,mpi_comm)
CALL mpi_bc(this%nbands,rank,mpi_comm)
......@@ -120,8 +108,8 @@ MODULE m_types_hybrid
ALLOCATE(this%lcutm1(ntype),this%lcutwf(ntype),this%select1(4,ntype))
numberNodes = xml%GetNumberOfNodes('/fleurInput/calculationSetup/prodBasis')
IF (numberNodes==1) THEN
this%gcutm1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@gcutm'))
this%tolerance1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@tolerance'))
!this%gcutm1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@gcutm'))
!this%tolerance1=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@tolerance'))
this%ewaldlambda=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@ewaldlambda'))
this%lexp=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@lexp'))
this%bands1=evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/prodBasis/@bands'))
......
......@@ -61,6 +61,7 @@ MODULE m_types_input
REAL :: ellow=-1.8
REAL :: elup=1.0
REAL :: fixed_moment = 0.0
LOGICAL :: l_removeMagnetisationFromInterstitial
CHARACTER(LEN=100) :: comment="FLEUR calculation without a title"
LOGICAL :: l_core_confpot=.TRUE. !Former CPP_CORE
LOGICAL :: l_useapw=.FALSE.
......@@ -135,6 +136,7 @@ CONTAINS
call mpi_bc(this%l_wann,rank,mpi_comm)
call mpi_bc(this%secvar,rank,mpi_comm)
call mpi_bc(this%evonly,rank,mpi_comm)
call mpi_bc(this%l_removeMagnetisationFromInterstitial,rank,mpi_comm)
! call mpi_bc(this%l_inpXML,rank,mpi_comm)
call mpi_bc(this%ellow,rank,mpi_comm)
call mpi_bc(this%elup,rank,mpi_comm)
......@@ -218,6 +220,7 @@ CONTAINS
this%jspins = evaluateFirstIntOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@jspins'))
this%swsp = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@swsp'))
this%lflip = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@lflip'))
this%l_removeMagnetisationFromInterstitial=evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@l_removeMagnetisationFromInterstitial'))
this%fixed_moment=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@fixed_moment'))
! Read in optional expert modes switches
xPathA = '/fleurInput/calculationSetup/expertModes'
......
......@@ -34,12 +34,48 @@ MODULE m_types_kpts
PROCEDURE :: print_xml
PROCEDURE :: read_xml=>read_xml_kpts
PROCEDURE :: mpi_bc => mpi_bc_kpts
procedure :: get_nk => kpts_get_nk
procedure :: to_first_bz => kpts_to_first_bz
procedure :: is_kpt => kpts_is_kpt
ENDTYPE t_kpts
PUBLIC :: t_kpts
CONTAINS
function kpts_get_nk(kpts, kpoint) result(ret_idx)
! get the index of a kpoint
implicit NONE
class(t_kpts), intent(in) :: kpts
real, intent(in) :: kpoint(3)
integer :: idx, ret_idx
DO idx = 1, kpts%nkptf
IF (all(abs(kpoint - kpts%bkf(:,idx)) < 1E-06)) THEN
ret_idx = idx
return
END IF
END DO
ret_idx = 0
end function kpts_get_nk
function kpts_to_first_bz(kpts, kpoint) result(out_point)
implicit NONE
class(t_kpts), intent(in) :: kpts
real, intent(in) :: kpoint(3)
real :: out_point(3)
out_point = kpoint - floor(kpoint)
end function kpts_to_first_bz
function kpts_is_kpt(kpts, kpoint) result(is_kpt)
implicit none
class(t_kpts), intent(in) :: kpts
real, intent(in) :: kpoint(3)
logical :: is_kpt
is_kpt = kpts%get_nk(kpoint) > 0
end function kpts_is_kpt
SUBROUTINE mpi_bc_kpts(this,mpi_comm,irank)
USE m_mpi_bc_tool
CLASS(t_kpts),INTENT(INOUT)::this
......
......@@ -4,18 +4,18 @@ MODULE m_hf_init
! preparations for HF and hybrid functional calculation
!
CONTAINS
SUBROUTINE hf_init(mpbasis, hybrid, atoms, input, DIMENSION, hybdat)
SUBROUTINE hf_init(mpbasis, hybrid, atoms, input, hybdat)
USE m_types
USE m_hybrid_core
USE m_util
use m_intgrf
USE m_io_hybrid
USE m_types_hybdat
IMPLICIT NONE
TYPE(t_mpbasis), intent(inout) :: mpbasis
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_input), INTENT(IN) :: input
TYPE(t_dimension), INTENT(IN) :: DIMENSION
TYPE(t_hybdat), INTENT(OUT) :: hybdat
INTEGER:: l, m, i, l1, l2, m1, m2, ok
......@@ -31,7 +31,7 @@ CONTAINS
allocate(hybdat%drbas1_MT(maxval(mpbasis%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype), source=0.0)
! preparations for core states
CALL core_init(dimension, input, atoms, hybdat%lmaxcd, hybdat%maxindxc)
CALL core_init( input, atoms, hybdat%lmaxcd, hybdat%maxindxc)
allocate(hybdat%nindxc(0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%nindxc')
allocate(hybdat%core1(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok, source=0.0)
......
......@@ -5,7 +5,7 @@
SUBROUTINE checkolap(atoms, hybdat,&
mpbasis,hybrid,&
nkpti, kpts,&
dimension, mpi, &
mpi, &
input, sym, noco,&
cell, lapw, jsp)
USE m_util, ONLY: chr, sphbessel, harmonicsr
......@@ -13,12 +13,13 @@
USE m_constants
USE m_types
USE m_io_hybrid
USE m_types_hybdat
IMPLICIT NONE
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_mpbasis), intent(in) :: mpbasis
TYPE(t_hybrid), INTENT(IN) :: hybrid
TYPE(t_input), INTENT(IN) :: input
......
......@@ -36,12 +36,12 @@ MODULE m_coulombmatrix
CONTAINS
SUBROUTINE coulombmatrix(mpi, atoms, kpts, cell, sym, mpbasis, hybrid, xcpot)
USE m_types_hybdat
USE m_types
USE m_juDFT
USE m_constants, ONLY: pi_const
USE m_olap, ONLY: olap_pw
use m_types_hybrid, only: gptnorm
use m_types_hybdat, only: gptnorm
USE m_trafo, ONLY: symmetrize, bramat_trafo
USE m_intgrf, ONLY: intgrf, intgrf_init
use m_util, only: primitivef
......
......@@ -16,9 +16,10 @@
! It is done directly without employing the mixed basis set.
MODULE m_exchange_core
USE m_types_hybdat
CONTAINS