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

Many fixes to be able to compile after merge

parent 0e969444
......@@ -3,9 +3,9 @@
! This file is part of FLEUR and avhttps://gcc.gnu.org/onlinedocs/gfortran/SQRT.htmlailable as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!------------------------------------------------------------------------------
! This routine allows to rotate the cdn in a way that the direction of magnetization aligns with the direction of the spin quantization axis.
! This routine also allows to reverse the rotation by using the angles stored in atoms (phi_mt_avg,theta_mt_avg) which are generated by the
! routine magnMomFromDen.
! This routine allows to rotate the cdn in a way that the direction of magnetization aligns with the direction of the spin quantization axis.
! This routine also allows to reverse the rotation by using the angles stored in atoms (phi_mt_avg,theta_mt_avg) which are generated by the
! routine magnMomFromDen.
!
! Robin Hilgers, Nov '19
MODULE m_alignSpinAxisMagn
......@@ -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
......@@ -28,20 +28,20 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden), INTENT(INOUT) :: den
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()
pi=pimach()
!!TEMP
! REAL :: x,y,z
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
! IF (abs(atoms%theta_mt_avg(i)).LE. 0.001) THEN
! atoms%phi_mt_avg(i)=0.0
! atoms%theta_mt_avg(i)=0.0
! END IF
......@@ -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,18 +64,16 @@ 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
IF(noco%beta(i)<0) THEN
noco%beta(i)=-noco%beta(i)
noco%alph=noco%alph+pi
noco%beta(i)=-noco%beta(i)
noco%alph=noco%alph+pi
END IF
IF(noco%beta(i)>pi) THEN
IF(noco%beta(i)>pi) THEN
noco%beta(i)=pi-mod(noco%beta(i),pi)
noco%alph(i)=noco%alph(i)+pi
END IF
......@@ -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)
atoms%flipSpinPhi=0
atoms%flipSpinTheta=0
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)
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,9 +64,9 @@ 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)
cdn22 = rho(i,ilh,iType,2)
cdn21 = CMPLX(rho(i,ilh,iType,3),rho(i,ilh,iType,4))
......@@ -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
......
......@@ -3,15 +3,15 @@
! This file is part of FLEUR and avhttps://gcc.gnu.org/onlinedocs/gfortran/SQRT.htmlailable as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!------------------------------------------------------------------------------
! This routine calculates the magnetic moments and the corresponding directions
! (angles) according to the Atoms in the system.
!
! This routine calculates the magnetic moments and the corresponding directions
! (angles) according to the Atoms in the system.
!
!
! Robin Hilgers, Nov '19
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
......@@ -35,34 +37,34 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
IF(noco%l_mtNocoPot) THEN
jsp=4
ELSE
ELSE
jsp=input%jspins
END IF
!!Loop over Spins and Atoms
DO i=1, atoms%ntype
DO i=1, atoms%ntype
DO j=1, jsp
!!Integration over r
CALL intgr3(den%mt(:,0,i,j), atoms%rmsh(:,i),atoms%dx(i),atoms%jri(i),dummyResults(i,j))
!!Considering Lattice harmonics integral (Only L=0 component does not vanish and has a factor of sqrt(4*Pi))
dummyResults(i,j)=dummyResults(i,j)*sfp_const
END DO
END DO
END DO
!!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
......
......@@ -9,14 +9,14 @@ CONTAINS
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! This subroutine calculates and writes out intraatomic electric and magnetic dipole
! This subroutine calculates and writes out intraatomic electric and magnetic dipole
! moments resolved with respect to their orbital (angular momentum) origins.
!
! GM'2018
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
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
......
......@@ -9,44 +9,31 @@ MODULE m_types_hybrid
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
TYPE,EXTENDS(t_fleurinput_base):: t_hybrid
LOGICAL :: l_hybrid = .false.
LOGICAL :: l_subvxc = .false.
LOGICAL :: l_calhf = .false.
LOGICAL :: l_addhf = .false.
INTEGER :: ewaldlambda =3
INTEGER :: lexp =16
INTEGER :: bands1 !Only read in
INTEGER :: nbasp
INTEGER :: maxlcutm1
INTEGER :: maxindxm1
INTEGER :: maxbasm1
INTEGER :: maxindxp1
INTEGER :: maxgptm
INTEGER :: maxgptm1
INTEGER :: maxindx
INTEGER :: maxlmindx
INTEGER :: gptmd
INTEGER, ALLOCATABLE :: nindx(:, :)
INTEGER, ALLOCATABLE :: select1(:, :)
LOGICAL :: l_hybrid = .false.
LOGICAL :: l_subvxc = .false.
LOGICAL :: l_calhf = .false.
LOGICAL :: l_addhf = .false.
INTEGER :: ewaldlambda
INTEGER :: lexp = 0
INTEGER :: bands1 !Only read in
INTEGER :: nbasp
INTEGER :: maxbasm1
INTEGER :: max_indx_p_1 !new
INTEGER :: maxlmindx
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 :: 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(:, :, :)
INTEGER, ALLOCATABLE :: map(:,:)
INTEGER, ALLOCATABLE :: tvec(:,:,:)
INTEGER, ALLOCATABLE :: nbasm(:)
!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)
......@@ -111,8 +99,8 @@ MODULE m_types_hybrid
USE m_types_xml
CLASS(t_hybrid),INTENT(INout):: this
TYPE(t_xml),INTENT(in) :: xml
INTEGER::numberNodes,ntype,itype
CHARACTER(len=100)::xPathA
......@@ -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