Commit 734a94db authored by Daniel Wortmann's avatar Daniel Wortmann

Added more IO functionality to types

parent 681a9ed7
......@@ -5,10 +5,11 @@
!--------------------------------------------------------------------------------
MODULE m_types_dmi
USE m_types
USE m_types_forcetheo
USE m_judft
IMPLICIT NONE
PRIVATE
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_dmi
INTEGER :: q_done
REAL,ALLOCATABLE:: qvec(:,:)
......@@ -22,10 +23,24 @@ MODULE m_types_dmi
PROCEDURE :: postprocess => dmi_postprocess
PROCEDURE :: init => dmi_init !not overloaded
PROCEDURE :: dist => dmi_dist !not overloaded
PROCEDURE :: read_xml=> dmi_read_xml
END TYPE t_forcetheo_dmi
PUBLIC t_forcetheo_dmi
CONTAINS
SUBROUTINE dmi_read_xml(dmi,xml)
USE m_types_xml
CLASS(t_forcetheo_dmi),INTENT(OUT):: dmi
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=200)::lstring,nstring
IF (xml%GetNumberOfNodes('/fleurInput/forceTheorem/DMI')==1) THEN
lString=xml%GetAttributeValue('/fleurInput/forceTheorem/DMI/@theta')
nString=xml%GetAttributeValue('/fleurInput/forceTheorem/DMI/@phi')
CALL dmi%init(xml%read_q_list('/fleurInput/forceTheorem/DMI/qVectors'),lstring,nstring)
ENDIF
END SUBROUTINE dmi_read_xml
SUBROUTINE dmi_init(this,q,theta_s,phi_s)
USE m_calculator
USE m_constants
......
......@@ -16,7 +16,6 @@ MODULE m_types_jij
REAL,ALLOCATABLE:: qvec(:,:)
REAL :: thetaj
REAL,ALLOCATABLE:: taual_types(:,:)
REAL,ALLOCATABLE:: evsum(:)
CONTAINS
PROCEDURE :: start =>jij_start
......@@ -25,39 +24,42 @@ MODULE m_types_jij
PROCEDURE :: postprocess => jij_postprocess
PROCEDURE :: init => jij_init !not overloaded
PROCEDURE :: dist => jij_dist !not overloaded
PROCEDURE :: read_xml => read_xml_jij
END TYPE t_forcetheo_jij
CONTAINS
SUBROUTINE jij_init(this,q,thetaj,atoms)
SUBROUTINE read_xml_jij(jij,xml)
USE m_types_xml
CLASS(t_forcetheo_jij),INTENT(OUT):: jij
TYPE(t_xml),INTENT(IN) :: xml
IF (xml%GetNumberOfNodes('/fleurInput/forceTheorem/Jij')==1) THEN
jij%qvec=xml%read_q_list('/fleurInput/forceTheorem/Jij/qVectors')
jij%thetaj=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/forceTheorem/Jij/@thetaj'))
ENDIF
END SUBROUTINE read_xml_jij
SUBROUTINE jij_init(this,atoms)
USE m_types_setup
USE m_constants
IMPLICIT NONE
CLASS(t_forcetheo_jij),INTENT(INOUT):: this
REAL,INTENT(in) :: q(:,:),thetaj
TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER:: n,na,ni,nj,j
REAL,PARAMETER:: eps=1E-5
!Store data
ALLOCATE(this%taual_types(3,atoms%ntype))
na=1
DO n=1,atoms%ntype
this%taual_types(:,n)=atoms%taual(:,na)
na=na+atoms%neq(n)
ENDDO
ALLOCATE(this%qvec(3,SIZE(q,2)))
this%qvec=q
this%thetaj=thetaj
!Max no of loops...
n=atoms%nat**2*SIZE(q,2)+1
n=atoms%nat**2*SIZE(this%qvec,2)+1
ALLOCATE(this%q_index(n),this%iatom(n),this%jatom(n),this%phase2(n))
!now construct the loops
this%no_loops=0
DO n=1,SIZE(q,2)
DO n=1,SIZE(this%qvec,2)
DO ni=1,atoms%ntype
IF (ABS(atoms%bmu(ni))<eps) CYCLE !no magnetic atom
DO nj=ni,atoms%ntype
......@@ -73,6 +75,7 @@ CONTAINS
END DO
END DO
END DO
ALLOCATE(this%evsum(this%no_loops))
this%evsum=0
END SUBROUTINE jij_init
......@@ -143,8 +146,8 @@ CONTAINS
noco%beta(this%jatom(this%loopindex))=this%thetaj
!rotate according to q-vector
DO n = 1,SIZE(this%taual_types,2)
noco%alph(n) = noco%alph(n) + tpi_const*dot_PRODUCT(noco%qss,this%taual_types(:,n))
DO n = 1,atoms%ntype
noco%alph(n) = noco%alph(n) + tpi_const*DOT_PRODUCT(noco%qss,atoms%taual(:,SUM(atoms%neq(:n-1))+1))
ENDDO
IF (.NOT.this%l_io) RETURN
......
......@@ -8,6 +8,8 @@ MODULE m_types_mae
USE m_types
USE m_types_forcetheo
USE m_judft
IMPLICIT NONE
PRIVATE
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_mae
INTEGER :: directions_done
REAL,ALLOCATABLE:: theta(:)
......@@ -20,10 +22,27 @@ MODULE m_types_mae
PROCEDURE :: postprocess => mae_postprocess
PROCEDURE :: init => mae_init !not overloaded
PROCEDURE :: dist => mae_dist !not overloaded
PROCEDURE :: read_xml => read_xml_mae
END TYPE t_forcetheo_mae
PUBLIC t_forcetheo_mae
CONTAINS
SUBROUTINE mae_init(this,cell,sym,theta_s,phi_s)
SUBROUTINE read_xml_mae(mae,xml)
USE m_types_xml
CLASS(t_forcetheo_mae),INTENT(OUT):: mae
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=200)::str
IF (xml%GetNumberOfNodes('/fleurInput/forceTheorem/MAE')==1) THEN
str=xml%GetAttributeValue('/fleurInput/forceTheorem/MAE/@theta')
CALL evaluateList(mae%theta,str)
str=xml%GetAttributeValue('/fleurInput/forceTheorem/MAE/@phi')
CALL evaluateList(mae%phi,str)
ENDIF
END SUBROUTINE read_xml_mae
SUBROUTINE mae_init(this,cell,sym)
USE m_calculator
USE m_socsym
USE m_types
......@@ -31,13 +50,10 @@ CONTAINS
CLASS(t_forcetheo_mae),INTENT(INOUT):: this
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sym),INTENT(IN) :: sym
CHARACTER(len=*),INTENT(INOUT) :: theta_s,phi_s
INTEGER::n
LOGICAL::error(sym%nop)
CALL evaluateList(this%theta,theta_s)
CALL evaluateList(this%phi,phi_s)
IF (SIZE(this%phi).NE.SIZE(this%theta)) CALL &
judft_error("Lists for theta/phi must have the same length in MAE force theorem calculations")
......
......@@ -9,6 +9,7 @@ MODULE m_types_ssdisp
USE m_types
USE m_types_forcetheo
USE m_judft
IMPLICIT NONE
TYPE,EXTENDS(t_forcetheo) :: t_forcetheo_ssdisp
INTEGER :: q_done
REAL,ALLOCATABLE:: qvec(:,:)
......@@ -20,10 +21,21 @@ MODULE m_types_ssdisp
PROCEDURE :: postprocess => ssdisp_postprocess
PROCEDURE :: init => ssdisp_init !not overloaded
PROCEDURE :: dist => ssdisp_dist !not overloaded
PROCEDURE :: real_xml =>read_xml_ssdisp
END TYPE t_forcetheo_ssdisp
CONTAINS
SUBROUTINE read_xml_ssdisp(ssdisp,xml)
USE m_types_xml
CLASS(t_forcetheo_ssdisp),INTENT(OUT):: ssdisp
TYPE(t_xml),INTENT(IN) :: xml
IF (xml%GetNumberOfNodes('/fleurInput/forceTheorem/spinSpiralDispersion')==1) THEN
ssdisp%qvec=xml%read_q_list('/fleurInput/forceTheorem/spinSpiralDispersion')
ENDIF
END SUBROUTINE read_xml_ssdisp
SUBROUTINE ssdisp_init(this,q)
USE m_calculator
USE m_constants
......
......@@ -20,6 +20,7 @@ MODULE m_constants
REAL, PARAMETER :: hartree_to_ev_const=27.21138602 ! value from 2014 CODATA recommended values. Uncertainty is 0.00000017
REAL, PARAMETER :: eVac0Default_const = -0.25
CHARACTER(len=9), PARAMETER :: version_const = 'fleur 27'
REAL, PARAMETER :: boltzmann_const = 3.1668114e-6 ! value is given in Hartree/Kelvin
INTEGER, PARAMETER :: POTDEN_TYPE_OTHER = 0 ! POTDEN_TYPE <= 0 ==> undefined
INTEGER, PARAMETER :: POTDEN_TYPE_POTTOT = 1 ! 0 < POTDEN_TYPE <= 1000 ==> potential
......
......@@ -536,9 +536,10 @@ SUBROUTINE calc_divergence(cell,kpts,divergence)
cdum = sqrt(expo)*rrad
divergence = cell%omtil / (tpi_const**2) * sqrt(pi_const/expo) * cerf(cdum)
rrad = rrad**2
kv1 = cell%bmat(1,:)/kpts%nkpt3(1)
kv2 = cell%bmat(2,:)/kpts%nkpt3(2)
kv3 = cell%bmat(3,:)/kpts%nkpt3(3)
CALL judft_error("Missing function for hybrid code here...")
! kv1 = cell%bmat(1,:)/kpts%nkpt3(1)
! kv2 = cell%bmat(2,:)/kpts%nkpt3(2)
! kv3 = cell%bmat(3,:)/kpts%nkpt3(3)
n = 1
found = .true.
......
......@@ -52,7 +52,8 @@ SUBROUTINE symm_hf_init(sym,kpts,nk,nsymop,rrot,psym)
rotkpt = matmul(rrot(:,:,i), kpts%bkf(:,nk))
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rotkpt = modulo1(rotkpt,kpts%nkpt3)
!check if rotkpt is identical to bk(:,nk)
IF(maxval(abs(rotkpt - kpts%bkf(:,nk))) .LE. 1E-07) THEN
......@@ -162,7 +163,8 @@ SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
rotkpt = matmul( rrot(:,:,psym(iop)), kpts%bkf(:,ikpt) )
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rotkpt = modulo1(rotkpt,kpts%nkpt3)
!determine number of rotkpt
nrkpt = 0
......@@ -224,7 +226,8 @@ SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
rotkpt = matmul( rrot(:,:,isym), kpts%bkf(:,ikpt) )
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rotkpt = modulo1(rotkpt,kpts%nkpt3)
!check if rotkpt is identical to bk(:,ikpt)
IF( maxval( abs( rotkpt - kpts%bkf(:,ikpt) ) ) .le. 1E-06) THEN
......@@ -581,7 +584,8 @@ INTEGER FUNCTION symm_hf_nkpt_EIBZ(kpts,nk,sym)
rotkpt = matmul( rrot(:,:,iop), kpts%bkf(:,nk) )
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rotkpt = modulo1(rotkpt,kpts%nkpt3)
!check if rotkpt is identical to bk(:,nk)
IF( maxval( abs( rotkpt - kpts%bkf(:,nk) ) ) .le. 1E-07) THEN
......@@ -616,7 +620,8 @@ INTEGER FUNCTION symm_hf_nkpt_EIBZ(kpts,nk,sym)
rotkpt = matmul( rrot(:,:,psym(iop)), kpts%bkf(:,ikpt) )
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rotkpt = modulo1(rotkpt,kpts%nkpt3)
!determine number of rotkpt
nrkpt = 0
......
......@@ -77,7 +77,8 @@
rkpt = matmul(rrot,kpts%bk(:,nk))
rkpthlp = rkpt
rkpt = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rkpt = modulo1(rkpt,kpts%nkpt3)
g1 = nint(rkpt - rkpthlp)
......@@ -227,7 +228,8 @@
rkpt = matmul(rrot,kpts%bk(:,nk))
rkpthlp = rkpt
rkpt = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rkpt = modulo1(rkpt,kpts%nkpt3)
g1 = nint(rkpt - rkpthlp)
! MT coefficients
......@@ -643,7 +645,8 @@
rkpt = matmul(rrot,kpts%bkf(:,ikpt0))
rkpthlp = rkpt
rkpt = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rkpt = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpthlp-rkpt)
#ifdef CPP_DEBUG
......@@ -854,7 +857,8 @@
rrot = transpose( sym%mrot(:,:,sym%invtab(iisym)) )
invrrot = transpose( sym%mrot(:,:,iisym) )
rkpt = matmul(rrot,kpts%bk(:,ikpt0))
rkpthlp = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rkpthlp = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpt - rkpthlp)
......@@ -871,7 +875,8 @@
rrot = -transpose( sym%mrot(:,:,sym%invtab(iisym)) )
invrrot = -transpose( sym%mrot(:,:,iisym) )
rkpt = matmul(rrot,kpts%bk(:,ikpt0))
rkpthlp = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rkpthlp = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpt - rkpthlp)
matin1 = conjg(matin1)
......@@ -1138,9 +1143,9 @@
dwgn(-maxlcutm:maxlcutm,-maxlcutm:maxlcutm,l) =&
transpose(hybrid%d_wgn2(-maxlcutm:maxlcutm,-maxlcutm:maxlcutm,l,isym))
END DO
rkpt = matmul(rrot,kpts%bk(:,ikpt0))
rkpthlp = modulo1(rkpt,kpts%nkpt3)
rkpt = MATMUL(rrot,kpts%bk(:,ikpt0))
CALL judft_error("Missing function for hybrid code here...")
!rkpthlp = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpt - rkpthlp)
! determine number of rotated k-point bk(:,ikpt) -> ikpt1
......@@ -1372,7 +1377,8 @@
rrot = transpose( sym%mrot(:,:,sym%invtab(iisym)) )
invrrot = transpose( sym%mrot(:,:,iisym) )
rkpt = matmul(rrot,kpts%bk(:,ikpt0))
rkpthlp = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rkpthlp = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpt - rkpthlp)
CALL d_wigner(invrot,cell%bmat,maxlcutm,dwgn(:,:,1:maxlcutm))
......@@ -1388,7 +1394,8 @@
invrot = sym%mrot(:,:,sym%invtab(iisym))
invrrot = -transpose( sym%mrot(:,:,iisym) )
rkpt = matmul(rrot,kpts%bk(:,ikpt0))
rkpthlp = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!rkpthlp = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpt - rkpthlp)
vecin1 = conjg(vecin1)
......@@ -1579,7 +1586,8 @@
END IF
rkpt = matmul(rrot,kpts%bk(:,ikpt0))
rkpthlp = modulo1(rkpt,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
! rkpthlp = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpt - rkpthlp)
DO l = 0,maxlcutm
......@@ -1763,7 +1771,8 @@
END IF
rkpthlp = matmul(rrot,kpts%bk(:,ikpt0))
rkpt = modulo1(rkpthlp,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
! rkpt = modulo1(rkpthlp,kpts%nkpt3)
g = nint(rkpthlp-rkpt)
!
! determine number of rotated k-point bk(:,ikpt) -> ikpt1
......
......@@ -101,7 +101,8 @@
kqpthlp = kpts%bkf(:,nk) + kpts%bkf(:,iq)
! k+q can lie outside the first BZ, transfer
! it back into the 1. BZ
kqpt = modulo1(kqpthlp,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!kqpt = modulo1(kqpthlp,kpts%nkpt3)
g_t(:) = nint( kqpt - kqpthlp )
! determine number of kqpt
nkqpt = 0
......@@ -394,7 +395,8 @@
kqpthlp = kpts%bkf(:,nk) + kpts%bkf(:,iq)
! kqpt can lie outside the first BZ, transfer it back
kqpt = modulo1(kqpthlp,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!kqpt = modulo1(kqpthlp,kpts%nkpt3)
g_t(:) = nint( kqpt - kqpthlp )
! determine number of kqpt
nkqpt = 0
......@@ -1342,7 +1344,8 @@
kqpthlp = kpts%bkf(:,nk) + kpts%bkf(:,iq)
! kqpt can lie outside the first BZ, transfer it back
kqpt = modulo1(kqpthlp,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!kqpt = modulo1(kqpthlp,kpts%nkpt3)
g_t(:) = nint( kqpt - kqpthlp )
! determine number of kqpt
nkqpt = 0
......@@ -2364,7 +2367,8 @@
kqpthlp = kpts%bkf(:,nk) + kpts%bkf(:,iq)
! k+q can lie outside the first BZ, transfer
! it back into the 1. BZ
kqpt = modulo1(kqpthlp,kpts%nkpt3)
CALL judft_error("Missing function for hybrid code here...")
!kqpt = modulo1(kqpthlp,kpts%nkpt3)
g_t(:) = nint( kqpt - kqpthlp )
! determine number of kqpt
nkqpt = 0
......
......@@ -52,8 +52,8 @@
IF(PRESENT(enpara)) THEN
IF (.NOT.input%l_inpXML) THEN
!read enpara file if present!
CALL enpara%init(atoms,input%jspins)
CALL enpara%READ(atoms,input%jspins,input%film,.false.)
CALL enpara%init(atoms%ntype,atoms%nlod,atoms%lmaxd,input%jspins)
CALL enpara%READ(atoms%ntype,atoms%nlo,input%jspins,input%film,.false.)
END IF
END IF
!
......
......@@ -64,6 +64,7 @@ ${FLEUR_SRC}/math/matmul.f
${FLEUR_SRC}/init/strgn_dim.F
${FLEUR_SRC}/init/spgrot.f
${FLEUR_SRC}/init/convn_dim.f
${FLEUR_SRC}/io/types_xml.f90
......@@ -83,6 +84,8 @@ ${FLEUR_SRC}/types/types_mpimat.F90
${FLEUR_SRC}/types/types_potden.F90
${FLEUR_SRC}/types/types_forcetheo.F90
${FLEUR_SRC}/types/types_kpts.f90
${FLEUR_SRC}/types/types_wannier.f90
${FLEUR_SRC}/types/types_coreSpecInput.f90
${FLEUR_SRC}/types/types_enpara.F90
${FLEUR_SRC}/types/types_setup.F90
${FLEUR_SRC}/types/types_usdus.F90
......
......@@ -117,7 +117,7 @@ CONTAINS
ALLOCATE(atoms%ulo_der(atoms%nlod,atoms%ntype))
atoms%ulo_der=0
CALL enpara%init(atoms,2,.TRUE.)
CALL enpara%init(atoms%ntype,atoms%nlod,atoms%lmaxd,2,.TRUE.)
DO n=1,atoms%ntype
DO i=1,atoms%nlo(n)
DO l = 0, 3
......
......@@ -87,7 +87,7 @@
CHARACTER(len=3), ALLOCATABLE :: noel(:)
LOGICAL, ALLOCATABLE :: error(:)
INTEGER ntp1,ii
INTEGER ntp1,ii,grid(3)
INTEGER, ALLOCATABLE :: lmx1(:), nq1(:), nlhtp1(:)
! added for HF and hybrid functionals
......@@ -108,7 +108,7 @@
!---> determine ntype,nop,natd,nwdd,nlod and layerd
!
CALL first_glance(atoms%ntype,sym%nop,atoms%nat,atoms%nlod,vacuum%layerd,&
input%itmax,l_kpts,l_qpts,l_gamma,kpts%nkpt,kpts%nkpt3,nmopq)
input%itmax,l_kpts,l_qpts,l_gamma,kpts%nkpt,grid,nmopq)
atoms%ntype=atoms%ntype
atoms%nlod = max(atoms%nlod,1)
......@@ -131,7 +131,7 @@
CALL rw_inp('r',&
& atoms,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,latnam)
& noel,namex,relcor,a1,a2,a3,latnam,grid)
!---> pk non-collinear
!---> read the angle and spin-spiral information from nocoinp
......
......@@ -10,7 +10,7 @@ CONTAINS
SUBROUTINE fleur_init_old(&
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,&
sliceplot,banddos,enpara,xcpot,kpts,hybrid,&
oneD)
oneD,grid)
USE m_types_input
USE m_types_dimension
USE m_types_atoms
......@@ -53,6 +53,7 @@ CONTAINS
TYPE(t_kpts) ,INTENT(INOUT):: kpts
TYPE(t_hybrid) ,INTENT(OUT) :: hybrid
TYPE(t_oneD) ,INTENT(OUT) :: oneD
INTEGER,INTENT(OUT)::grid(3)
! .. Local Scalars ..
......@@ -135,7 +136,7 @@ CONTAINS
CALL inped(atoms,vacuum,input,banddos,xcpot,sym,&
cell,sliceplot,noco,&
stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor,latnam)
stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor,latnam,grid)
!
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
......
......@@ -28,7 +28,7 @@
CONTAINS
SUBROUTINE inped(atoms,vacuum,input,banddos,xcpot,sym,&
cell,sliceplot,noco,&
stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor,latnam)
stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor,latnam,grid)
USE m_rwinp
!USE m_chkmt
USE m_inpnoco
......@@ -69,6 +69,7 @@
CHARACTER(len=4), INTENT(OUT) :: namex
CHARACTER(len=12), INTENT(OUT) :: relcor
CHARACTER(len=4),INTENT(OUT) ::latnam
INTEGER,INTENT(OUT):: grid(3)
! .. Local Scalars ..
REAL dr,dtild,r,kmax1,dvac1,zp
INTEGER i,iz,j,n,n1,na,ntst,nn,ios
......@@ -95,7 +96,7 @@
na = 0
CALL rw_inp('r',atoms,vacuum,input,stars,sliceplot,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3,latnam)
cell,sym,xcpot,noco,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3,latnam,grid)
input%l_core_confpot=.TRUE. !this is the former CPP_CORE switch!
input%l_useapw=.FALSE. !this is the former CPP_APW switch!
......
......@@ -11,7 +11,7 @@
SUBROUTINE rw_inp(&
& ch_rw,atoms,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,latnam,dtild_opt)!,name_opt)
& noel,namex,relcor,a1,a2,a3,latnam,grid)!,name_opt)
!*********************************************************************
!* This subroutine reads or writes an inp - file on unit iofile *
......@@ -57,8 +57,8 @@
CHARACTER(len=3),INTENT(OUT) :: noel(atoms%ntype)
CHARACTER(len=4),INTENT(OUT) :: namex
CHARACTER(len=12),INTENT(OUT):: relcor
REAL,INTENT(IN),OPTIONAL :: dtild_opt
CHARACTER(len=*),INTENT(INOUT)::latnam
INTEGER,INTENT(OUT)::grid(3)
!CHARACTER(len=8),INTENT(IN),OPTIONAL:: name_opt(10)
......@@ -99,7 +99,6 @@
INTEGER :: idum
CHARACTER (len=1) :: check
IF (PRESENT(dtild_opt)) dtild=dtild_opt
!IF (PRESENT(name_opt)) name=name_opt
! Initialize variables
......@@ -675,7 +674,7 @@
IF(namex=='hf '.OR.namex=='pbe0'.OR.namex=='exx '.OR.namex=='hse '.OR.namex=='vhse'.OR.&
(banddos%dos.AND.(banddos%ndir == -3))) THEN
READ (UNIT=5,FMT='(5x,i5,4x,i2,4x,i2,4x,i2)',END=98,ERR=98) idum,kpts%nkpt3(1),kpts%nkpt3(2),kpts%nkpt3(3)
READ (UNIT=5,FMT='(5x,i5,4x,i2,4x,i2,4x,i2)',END=98,ERR=98) idum,grid
IF(idum.EQ.0) THEN
WRITE(*,*) ''
......@@ -685,13 +684,13 @@
CALL juDFT_error("Invalid declaration of k-point set (1)",calledby="rw_inp")
END IF
IF( kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3) .ne. idum ) THEN
WRITE(*,*) ''
WRITE(*,*) 'nx*ny*nz is not equal to nkpt.'
WRITE(*,*) 'For this fleur mode this is required!'
WRITE(*,*) ''
CALL juDFT_error("Invalid declaration of k-point set (2)",calledby="rw_inp")
END IF
!IF( kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3) .ne. idum ) THEN
! WRITE(*,*) ''
! WRITE(*,*) 'nx*ny*nz is not equal to nkpt.'
! WRITE(*,*) 'For this fleur mode this is required!'
! WRITE(*,*) ''
! CALL juDFT_error("Invalid declaration of k-point set (2)",calledby="rw_inp")
!END IF
END IF
! for a exx calcuation a second mixed basis set is needed to
......
......@@ -40,18 +40,17 @@ CONTAINS
TYPE(t_forcetheo):: forcetheo
TYPE(t_kpts) ,INTENT(OUT):: kpts
!local only
TYPE(t_dimension) ::dimension
TYPE(t_sphhar) ::sphhar
TYPE(t_atompar) :: ap
INTEGER :: n
INTEGER :: n,grid(3)
CALL fleur_init_old(&
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,&
sliceplot,banddos,enpara,xcpot,kpts,hybrid,&
oneD)
oneD,grid) !kpt grid not used...
CALL sym%init(cell,input%film)
ALLOCATE(enpara%qn_el(0:3,atoms%ntype,2),enpara%qn_ello(size(enpara%ello0),atoms%ntype,2))
......@@ -69,5 +68,7 @@ CONTAINS
IF (atoms%nlo(n).NE.LEN_TRIM(ap%lo)/2) CALL judft_warn("Number of LOs changed in new version.")
call atoms%econf(n)%init(ap%econfig)
END DO
END SUBROUTINE read_old_inp
END MODULE m_read_old_inp
This diff is collapsed.
......@@ -12,9 +12,8 @@
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE m_types_xml
USE m_juDFT
USE m_calculator
PRIVATE
TYPE t_xml
......@@ -29,10 +28,187 @@ MODULE m_types_xml
PROCEDURE,NOPASS :: SetAttributeValue
PROCEDURE,NOPASS :: GetAttributeValue
PROCEDURE,NOPASS :: FreeResources
PROCEDURE :: read_q_list
PROCEDURE,NOPASS :: popFirstStringToken
PROCEDURE,NOPASS :: countStringTokens
PROCEDURE :: speciesPath
PROCEDURE,NOPASS :: groupPath
PROCEDURE :: get_nat
PROCEDURE :: get_lmaxd
PROCEDURE :: get_nlo
PROCEDURE :: get_ntype
PROCEDURE :: posPath
END TYPE t_xml
PUBLIC t_xml
PUBLIC t_xml,evaluateFirstOnly,EvaluateFirst,evaluateFirstBool,evaluateFirstBoolOnly,evaluateFirstInt,evaluateFirstIntOnly
CONTAINS
INTEGER FUNCTION get_lmaxd(xml)
CLASS(t_xml),INTENT(IN)::xml
INTEGER :: n
get_lmax=0
DO n=1,xml%GetNumberOfNodes('/fleurInput/atomSpecies/species')
get_lmaxd = MAX(get_lmaxd,evaluateFirstIntOnly(xml%GetAttributeValue(TRIM(xml%speciesPath(n))//'/atomicCutoffs/@lmax')))
ENDDO
END FUNCTION get_lmaxd
FUNCTION get_nlo(xml)
CLASS(t_xml),INTENT(IN)::xml
INTEGER,ALLOCATABLE::get_nlo(:)
INTEGER n
ALLOCATE(get_nlo(xml%get_ntype()))
DO n=1,xml%get_ntype()
get_nlo(n)=xml%GetNumberOfNodes(TRIM(xml%speciesPath(n))//'/lo')
ENDDO
END FUNCTION get_nlo
FUNCTION speciesPath(xml,itype)
CLASS(t_xml),INTENT(IN)::xml
INTEGER::itype
CHARACTER(len=:),ALLOCATABLE::speciesPath
INTEGER :: i
CHARACTER(len=200)::xpath,species
!First determine name of species from group
WRITE(xPath,*) '/fleurInput/atomGroups/atomGroup[',itype,']/@species'
species=TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(xPath)))))
DO i=1,xml%GetNumberOfNodes('/fleurInput/atomSpecies/species')
WRITE(xPath,*) '/fleurInput/atomSpecies/species[',i,']'
IF (TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(xPath))//'/@name')))==TRIM(species)) THEN
speciesPath=TRIM(xpath)
RETURN
END IF
END DO
WRITE(xpath,*) n
CALL judft_error("No species found for name "//TRIM(species)//" used in atom group "//TRIM(xpath))
END FUNCTION speciesPath
FUNCTION groupPath(itype)
IMPLICIT NONE