Commit b8bb564e authored by Daniel Wortmann's avatar Daniel Wortmann

Fixed compilation problems. IO missing for hybrid+GF

parent c1ac7f56
cmd: "make"
cwd: "$HOME/eclipse/fleur/build.debug"
errorMatch: "(?<file>[\\/0-9a-zA-Z\\._]+)\\((?<line>\\d+)\\): error"
......@@ -12,7 +12,7 @@ CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
vacuum,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,&
moments,coreSpecInput,mcd,slab,orbcomp,greensfCoeffs,angle)
moments,hub1,coreSpecInput,mcd,slab,orbcomp,greensfCoeffs,angle)
!************************************************************************************
! This is the FLEUR valence density generator
......@@ -51,6 +51,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
USE m_corespec_io, only : corespec_init
USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs
USE m_xmlOutput
#ifdef CPP_MPI
USE m_mpi_col_den ! collect density data from parallel nodes
#endif
......@@ -174,7 +175,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (noco%l_mperp.OR.input%l_gfmperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
IF (banddos%l_mcd) CALL mcd_init(atoms,input,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
IF (l_coreSpec) CALL corespec_rme(atoms,input,iType,29,input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g)
atoms%msh,vTot%mt(:,0,:,:),f,g)
END DO
DEALLOCATE (f,g,flo)
......
......@@ -83,7 +83,7 @@ END IF
IF (den%potdenType>1000) THEN
CALL pol_angle(mx,my,mz,theta_mt_avg(i),phi_mt_avg(i))
END IF
IF(mx<0) theta_mt_avg(i)=-atoms%theta_mt_avg(i)
IF(mx<0) theta_mt_avg(i)=-theta_mt_avg(i)
ENDDO
END SUBROUTINE magnMomFromDen
......
......@@ -9,7 +9,7 @@ MODULE m_tlmplm_cholesky
!*********************************************************************
CONTAINS
SUBROUTINE tlmplm_cholesky(sphhar,atoms,sym,noco,enpara,&
jspin,jsp,mpi,v,input,td,ud)
jspin,mpi,v,input,td,ud)
USE m_tlmplm
USE m_types
USE m_radovlp
......@@ -23,7 +23,7 @@ CONTAINS
TYPE(t_enpara),INTENT(IN) :: enpara
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jspin,jsp !physical spin&spin index for data
INTEGER, INTENT (IN) :: jspin!physical spin&spin index for data
! ..
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_tlmplm),INTENT(INOUT) :: td
......@@ -32,7 +32,7 @@ CONTAINS
! ..
! .. Local Scalars ..
REAL temp
INTEGER i,l,lm,lmin,lmin0,lmp,lmplm,lp,info,in
INTEGER i,l,lm,lmin,lmin0,lmp,lmplm,lp,info,in,jsp
INTEGER lpl ,mp,n,m,s,i_u
LOGICAL OK
! ..
......@@ -44,6 +44,7 @@ CONTAINS
! ..e_shift
jsp=jspin
td%e_shift(:,jsp)=0.0
IF (jsp<3) td%e_shift(:,jsp)=e_shift_min
......@@ -65,7 +66,7 @@ CONTAINS
!$OMP PRIVATE(temp,i,l,lm,lmin,lmin0,lmp)&
!$OMP PRIVATE(lmplm,lp,m,mp,n)&
!$OMP PRIVATE(OK,s,in,info)&
!$OMP SHARED(atoms,jspin,jsp,sphhar,enpara,td,ud,v,mpi,input,uun21,udn21,dun21,ddn21)
!$OMP SHARED(atoms,jspin,jsp,sym,sphhar,enpara,td,ud,v,mpi,input,uun21,udn21,dun21,ddn21)
DO n = 1,atoms%ntype
CALL tlmplm(n,sphhar,atoms,sym,enpara,jspin,jsp,mpi,v,input,td,ud)
OK=.FALSE.
......
......@@ -12,6 +12,24 @@ MODULE m_types_atoms
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
TYPE t_gfelementtype
SEQUENCE
!defines the l and atomType elements for given greens function element (used for mapping index in types_greensf)
INTEGER l
INTEGER lp
INTEGER atomType
INTEGER atomTypep
END TYPE t_gfelementtype
TYPE t_j0calctype
INTEGER atomType !atom Type for which to calculate J0
INTEGER l_min !Minimum l considered
INTEGER l_max !Maximum l considered
LOGICAL l_avgexc !Determines wether we average over the exchange splittings for all l
LOGICAL l_eDependence !Switch to output J0 with variating fermi energy (only with contourDOS)
END TYPE
TYPE t_utype
SEQUENCE
REAL :: u, j ! the actual U and J parameters
......@@ -33,6 +51,10 @@ MODULE m_types_atoms
INTEGER:: lmaxd
! no of lda+us
INTEGER ::n_u
INTEGER :: n_hia
INTEGER :: n_j0
! no of greens function calculations (in total)
INTEGER :: n_gf
! dimensions
INTEGER :: jmtd
INTEGER :: msh=0 !core state mesh was in dimension
......@@ -95,6 +117,11 @@ MODULE m_types_atoms
LOGICAL, ALLOCATABLE :: relcor(:)
!lda_u information(ntype)
TYPE(t_utype), ALLOCATABLE::lda_u(:)
TYPE(t_utype),ALLOCATABLE::lda_hia(:)
!j0 calc information
TYPE(t_gfelementtype), ALLOCATABLE::gfelem(:)
TYPE(t_j0calctype), ALLOCATABLE::j0(:)
INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype)
!flipSpinTheta and flipSpinPhi are the angles which are given
!in the input to rotate the charge den by these polar angles.
......@@ -112,7 +139,7 @@ MODULE m_types_atoms
procedure :: mpi_bc=>mpi_bc_atoms
END TYPE t_atoms
PUBLIC :: t_atoms
PUBLIC :: t_atoms,t_utype
CONTAINS
subroutine mpi_bc_atoms(this,mpi_comm,irank)
......@@ -126,7 +153,7 @@ MODULE m_types_atoms
else
rank=0
end if
print *,"Attention, HUB1 parameters not in BC"
call mpi_bc(this%ntype,rank,mpi_comm)
call mpi_bc(this%nat,rank,mpi_comm)
call mpi_bc(this%nlod,rank,mpi_comm)
......@@ -257,6 +284,8 @@ MODULE m_types_atoms
ALLOCATE(this%label(this%nat))
ALLOCATE(this%pos(3,this%nat))
ALLOCATE(this%rmt(this%ntype))
ALLOCATE(this%j0(this%ntype))
ALLOCATE(this%gfelem(4*This%ntype))
ALLOCATE(this%econf(this%ntype))
ALLOCATE(this%ncv(this%ntype)) ! For what is this?
ALLOCATE(this%lapw_l(this%ntype)) ! Where do I put this?
......@@ -523,5 +552,46 @@ MODULE m_types_atoms
where (abs(this%pos(3,:)-this%taual(3,:))>0.5) this%taual(3,:) = this%taual(3,:) / cell%amat(3,3)
this%pos(:,:) = matmul(cell%amat,this%taual(:,:))
end subroutine init_atoms
SUBROUTINE add_gfjob(nType,lmin,lmax,atoms,l_off,l_inter,l_nn)
USE m_juDFT
INTEGER, INTENT(IN) :: nType
INTEGER, INTENT(IN) :: lmin
INTEGER, INTENT(IN) :: lmax
TYPE(t_atoms), INTENT(INOUT) :: atoms
LOGICAL, INTENT(IN) :: l_off !l!=lp
LOGICAL, INTENT(IN) :: l_inter
LOGICAL, INTENT(IN) :: l_nn
INTEGER l,lp,i_gf
LOGICAL l_found
IF(l_inter) CALL juDFT_error("Intersite greens function not yet implemented",calledby="add_gfjob")
!TODO: add the nearest neighbours jobs
DO l = lmin, lmax
DO lp = MERGE(lmin,l,l_off), MERGE(lmax,l,l_off)
!Check if this job has already been added
l_found = .FALSE.
DO i_gf = 1, atoms%n_gf
IF(atoms%gfelem(i_gf)%l.NE.l) CYCLE
IF(atoms%gfelem(i_gf)%lp.NE.lp) CYCLE
IF(atoms%gfelem(i_gf)%atomType.NE.nType) CYCLE
IF(atoms%gfelem(i_gf)%atomTypep.NE.nType) CYCLE
l_found = .TRUE.
ENDDO
IF(l_found) CYCLE !This job is already in the array
atoms%n_gf = atoms%n_gf + 1
atoms%gfelem(atoms%n_gf)%l = l
atoms%gfelem(atoms%n_gf)%atomType = nType
atoms%gfelem(atoms%n_gf)%lp = lp
atoms%gfelem(atoms%n_gf)%atomTypep = nType !For now
ENDDO
ENDDO
END SUBROUTINE add_gfjob
END MODULE m_types_atoms
......@@ -21,6 +21,7 @@ MODULE m_types_banddos
REAL :: e1_dos=0.5
REAL :: e2_dos=-0.5
REAL :: sig_dos=0.015
INTEGER :: projdos !selects one atomtype and prints the projected dos if there are to many atoms
REAL :: e_mcd_lo =-10.0
REAL :: e_mcd_up= 0.0
LOGICAL :: unfoldband =.FALSE.
......
......@@ -27,6 +27,8 @@ MODULE m_types_input
INTEGER :: coretail_lmax =0
INTEGER :: itmax =9
REAL :: minDistance=1.0e-5
REAL :: minoccDistance !Distances for the density matrix in DFT+Hubbard 1 case
REAL :: minmatDistance
INTEGER :: maxiter=99
INTEGER :: imix=7
INTEGER :: gw=0
......@@ -68,6 +70,29 @@ MODULE m_types_input
LOGICAL :: ldauLinMix=.FALSE.
REAL :: ldauMixParam=0.1
REAL :: ldauSpinf=2.0
LOGICAL :: ldauAdjEnpara
LOGICAL :: l_dftspinpol
LOGICAL :: l_gfsphavg
LOGICAL :: l_gfmperp
LOGICAL :: l_resolvent
LOGICAL :: l_hist
INTEGER :: gf_ne
REAL :: gf_ellow
REAL :: gf_elup
INTEGER :: gf_mode
INTEGER :: gf_n
REAL :: gf_alpha
REAL :: gf_et
REAL :: gf_eb
INTEGER :: gf_n1
INTEGER :: gf_n2
INTEGER :: gf_n3
INTEGER :: gf_nmatsub
REAL :: gf_sigma
LOGICAL :: gf_anacont
LOGICAL :: gf_dosfermi
LOGICAL :: l_gf !this switch is used to make sure, that all bands are included in the calculation
LOGICAL :: gfTet !This switch will be true iff the tetrahedron were calculated from the equdistant grid
LOGICAL :: l_rdmft=.FALSE.
REAL :: rdmftOccEps=0.0
INTEGER :: rdmftStatesBelow=0
......@@ -297,6 +322,8 @@ CONTAINS
this%ldauLinMix = evaluateFirstBoolOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@l_linMix'))
this%ldauMixParam = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@mixParam'))
this%ldauSpinf = evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@spinf'))
this%ldauAdjEnpara = evaluateFirstBoolOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@l_adjEnpara'))
END IF
! Read in RDMFT parameters
xPathA = '/fleurInput/calculationSetup/rdmft'
......
......@@ -17,6 +17,6 @@ greensf/rot_gf.f90
greensf/occmtx.f90
greensf/gfDOS.f90
greensf/lstojmj.f90
greensf/calc_tetra.f90
greensf/calc_tetra.F90
greensf/calc_tria.f90
)
......@@ -17,7 +17,7 @@ MODULE m_calc_tetra
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
#ifdef CPP_HENNING
INTEGER p(0:kpts%nkpt3(1),0:kpts%nkpt3(2),0:kpts%nkpt3(3))
INTEGER tetra(4,24), ntetra,k1,k2,k3,ikpt,itetra,iarr(3)
REAL kcorn(8),vol
......@@ -100,7 +100,7 @@ MODULE m_calc_tetra
kpts%voltet = vtet
CALL timestop("Calculation of Tetrahedra")
#endif
END SUBROUTINE calc_tetra
......@@ -118,7 +118,7 @@ MODULE m_calc_tetra
REAL rlv(3,3),diag(4),d(3)
INTEGER idmin
#ifdef CPP_HENNING
!Calculate the lengths of the three diagonals
rlv(:,1) = cell%bmat(:,1) / kpts%nkpt3
rlv(:,2) = cell%bmat(:,2) / kpts%nkpt3
......@@ -154,6 +154,7 @@ MODULE m_calc_tetra
tetra(:,ntetra+1:ntetra+6) = reshape ( [ 2,6,4,5, 1,2,4,5, 1,3,4,5, 3,7,4,5, 7,8,4,5, 6,8,4,5 ], [ 4,6 ] )
ntetra = ntetra + 6
endif
#endif
END SUBROUTINE get_tetra
REAL FUNCTION det(m)
......@@ -163,5 +164,4 @@ MODULE m_calc_tetra
m(2,3)*m(3,2)*m(1,1) - m(2,1)*m(1,2)*m(3,3)
END FUNCTION det
END MODULE m_calc_tetra
\ No newline at end of file
END MODULE m_calc_tetra
......@@ -32,6 +32,5 @@ init/prp_qfft.f90
init/prp_xcfft.f90
init/stepf.F90
init/strgn.f90
init/postprocessInput.F90
init/lapw_dim.F90
)
......@@ -405,7 +405,7 @@
<xsd:element name="relPos" type="AtomPosType"/>
<xsd:element name="absPos" type="AtomPosType"/>
<xsd:element name="filmPos" type="AtomPosType"/>
</xsd:choice>
</xsd:choice>
<xsd:element maxOccurs="1" minOccurs="0" name="mtSphere" type="MTSphereType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="atomicCutoffs" type="AtomicCutoffsType"/>
<xsd:element maxOccurs="1" minOccurs="0" name="energyParameters" type="EnergyParametersType"/>
......@@ -645,7 +645,7 @@
<xsd:attribute default="0.05" name="mixParam" type="xsd:double" use="optional"/>
<xsd:attribute default="1.00" name="spinf" type="xsd:double" use="optional"/>
<xsd:attribute default="F" name="l_adjEnpara" type="FleurBool" use="optional"/>
</xsd:complexType>
</xsd:complexType>
<xsd:complexType name="LdaHIAGeneralType">
<xsd:attribute default="100.0" name="beta" type="xsd:double" use="optional"/>
......
......@@ -131,7 +131,7 @@ CONTAINS
CALL timestart("Initialization")
CALL fleur_init(mpi,input,field,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,sliceplot,&
banddos,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,wann,hub1)
banddos,enpara,xcpot,results,kpts,hybrid,oneD,coreSpecInput,hub1,wann)
CALL timestop("Initialization")
IF ( ( input%preconditioning_param /= 0 ) .AND. oneD%odi%d1 ) THEN
......
......@@ -16,7 +16,6 @@ CONTAINS
USE m_judft
USE m_juDFT_init
USE m_init_wannier_defaults
USE m_postprocessInput
USE m_gen_map
USE m_dwigner
!USE m_gen_bz
......
......@@ -105,7 +105,7 @@ CONTAINS
cell,oneD,sliceplot,mpi,noco,den,denRot,EnergyDen,vTot,vx,results)
!ToDo, check if this is needed for more potentials as well...
CALL vgen_finalize(mpi,dimension,oneD,field,cell,atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
CALL vgen_finalize(mpi,oneD,field,cell,atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
!DEALLOCATE(vcoul%pw_w)
CALL bfield(input,noco,atoms,field,vTot)
......
......@@ -109,7 +109,7 @@ CONTAINS
LOGICAL :: l_done(0:atoms%lmaxd,atoms%ntype,input%jspins)
LOGICAL :: lo_done(atoms%nlod,atoms%ntype,input%jspins)
REAL :: vbar,vz0,rj,tr
INTEGER :: n,jsp,l,ilo,j,ivac,irank
INTEGER :: n,jsp,l,ilo,j,ivac,irank,i
CHARACTER(LEN=20) :: attributes(5)
REAL :: e_lo(0:3,atoms%ntype)!Store info on branches to do IO after OMP
REAL :: e_up(0:3,atoms%ntype)
......@@ -246,7 +246,7 @@ CONTAINS
!Set the energy parameters to the same value
!We want the shell where Hubbard 1 is applied to
!be non spin-polarized
IF(mpi%irank.EQ.0) THEN
IF(irank.EQ.0) THEN
WRITE(6,FMT=*)
WRITE(6,"(A)") "For Hubbard 1 we treat the correlated shell to be non spin-polarized"
ENDIF
......@@ -262,13 +262,13 @@ CONTAINS
enpara%el0(4:,n,1) = enpara%el0(3,n,1)
enpara%el0(4:,n,2) = enpara%el0(3,n,1)
ENDIF
IF(mpi%irank.EQ.0) WRITE(6,"(A27,I3,A3,I1,A4,f16.10)") "New energy parameter atom ", n, " l ", l, "--> ", enpara%el0(l,n,1)
IF(irank.EQ.0) WRITE(6,"(A27,I3,A3,I1,A4,f16.10)") "New energy parameter atom ", n, " l ", l, "--> ", enpara%el0(l,n,1)
ENDDO
ENDIF
IF(input%ldauAdjEnpara.AND.atoms%n_u+atoms%n_hia>0) THEN
!If requested we can adjust the energy parameters to the LDA+U potential correction
IF(mpi%irank.EQ.0) THEN
IF(irank.EQ.0) THEN
WRITE(6,FMT=*)
WRITE(6,"(A)") "LDA+U corrections for the energy parameters"
ENDIF
......@@ -282,7 +282,7 @@ CONTAINS
tr = tr + REAL(v%mmpMat(i,i,j,jsp))
ENDDO
enpara%el0(l,n,jsp) = enpara%el0(l,n,jsp) + tr/REAL(2*l+1)
IF(mpi%irank.EQ.0) WRITE(6,"(A27,I3,A3,I1,A6,I1,A4,f16.10)")&
IF(irank.EQ.0) WRITE(6,"(A27,I3,A3,I1,A6,I1,A4,f16.10)")&
"New energy parameter atom ", n, " l ", l, " spin ", jsp,"--> ", enpara%el0(l,n,jsp)
ENDDO
ENDDO
......
MODULE m_types_hybdat
IMPLICIT NONE
TYPE t_hybdat
INTEGER :: lmaxcd, maxindxc
INTEGER :: maxfac
REAL, ALLOCATABLE :: gridf(:,:)
INTEGER, ALLOCATABLE :: nindxc(:,:)
INTEGER, ALLOCATABLE :: lmaxc(:)
REAL, ALLOCATABLE :: core1(:,:,:,:), core2(:,:,:,:)
REAL, ALLOCATABLE :: eig_c(:,:,:)
INTEGER, ALLOCATABLE :: kveclo_eig(:,:)
REAL, ALLOCATABLE :: sfac(:), fac(:)
REAL, ALLOCATABLE :: gauntarr(:,:,:,:,:,:)
REAL, ALLOCATABLE :: bas1(:,:,:,:), bas2(:,:,:,:)
REAL, ALLOCATABLE :: bas1_MT(:,:,:), drbas1_MT(:,:,:)
REAL, ALLOCATABLE :: prodm(:,:,:,:)
INTEGER, ALLOCATABLE :: pntgptd(:)
INTEGER, ALLOCATABLE :: pntgpt(:,:,:,:)
INTEGER, ALLOCATABLE :: nindxp1(:,:)
COMPLEX, ALLOCATABLE :: stepfunc(:,:,:)
contains
procedure :: set_stepfunction => set_stepfunction
END TYPE t_hybdat
contains
subroutine set_stepfunction(hybdat, cell, atoms, g, svol)
use m_types_cell
use m_types_atoms
use m_judft
implicit none
class(t_hybdat),INTENT(INOUT) :: hybdat
type(t_cell), INTENT(in) :: cell
type(t_atoms), INTENT(in) :: atoms
integer, INTENT(in) :: g(3)
real, INTENT(in) :: svol
integer :: i, j, k, ok
if (.not. allocated(hybdat%stepfunc)) then
call timestart("setup stepfunction")
ALLOCATE (hybdat%stepfunc(-g(1):g(1), -g(2):g(2), -g(3):g(3)), stat=ok)
IF (ok /= 0) then
call juDFT_error('wavefproducts_inv5: error allocation stepfunc')
endif
DO i = -g(1), g(1)
DO j = -g(2), g(2)
DO k = -g(3), g(3)
hybdat%stepfunc(i,j,k) = stepfunction(cell, atoms, [i, j, k])/svol
END DO
END DO
END DO
call timestop("setup stepfunction")
endif
end subroutine set_stepfunction
!private subroutine
FUNCTION stepfunction(cell, atoms, g)
USE m_types_cell
USE m_types_atoms
USE m_constants
IMPLICIT NONE
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_atoms), INTENT(IN) :: atoms
INTEGER, INTENT(IN) :: g(3)
COMPLEX :: stepfunction !Is real in inversion case
REAL :: gnorm, gnorm3, r, fgr
INTEGER :: itype, ieq, icent
gnorm = gptnorm(g, cell%bmat)
gnorm3 = gnorm**3
IF (abs(gnorm) < 1e-12) THEN
stepfunction = 1
DO itype = 1, atoms%ntype
stepfunction = stepfunction - atoms%neq(itype)*atoms%volmts(itype)/cell%omtil
END DO
ELSE
stepfunction = 0
icent = 0
DO itype = 1, atoms%ntype
r = gnorm*atoms%rmt(itype)
fgr = fpi_const*(sin(r) - r*cos(r))/gnorm3/cell%omtil
DO ieq = 1, atoms%neq(itype)
icent = icent + 1
stepfunction = stepfunction - fgr*exp(-cmplx(0., tpi_const*dot_product(atoms%taual(:,icent), g)))
ENDDO
ENDDO
ENDIF
END FUNCTION stepfunction
PURE FUNCTION gptnorm(gpt, bmat)
IMPLICIT NONE
REAL :: gptnorm
INTEGER, INTENT(IN) :: gpt(3)
REAL, INTENT(IN) :: bmat(3, 3)
gptnorm = norm2(matmul(gpt(:), bmat(:,:)))
END FUNCTION gptnorm
END MODULE m_types_hybdat
......@@ -84,7 +84,7 @@ CONTAINS
END IF
IF (PRESENT(denMat)) THEN
CALL makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,denMat,factor,Avec,icut)
CALL makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,denMat,factor,Avec)
RETURN
END IF
......@@ -236,8 +236,8 @@ CONTAINS
! whether the sourcefree routine made it sourcefree.
IF (PRESENT(denMat)) THEN
CALL buildAtest(stars,atoms,sphhar,vacuum,input,noco,sym,cell,1,aVec,icut,denMat,factor)
CALL sourcefree(mpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,icut,div,phi,cvec,corrB,checkdiv)
CALL buildAtest(stars,atoms,sphhar,vacuum,input,noco,sym,cell,1,aVec,denMat,factor)
CALL sourcefree(mpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,div,phi,cvec,corrB,checkdiv)
CALL plotBtest(stars, atoms, sphhar, vacuum, input, oneD, sym, cell, noco, aVec, div, phi, cvec, corrB, checkdiv)
ELSE
CALL buildAtest(stars,atoms,sphhar,vacuum,input,noco,sym,cell,0,aVec)
......
......@@ -7,7 +7,7 @@ MODULE m_vgen_finalize
USE m_juDFT
USE m_xcBfield
CONTAINS
SUBROUTINE vgen_finalize(mpi,dimension,oneD,field,cell,atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
SUBROUTINE vgen_finalize(mpi,oneD,field,cell,atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
! ***********************************************************
! FLAPW potential generator *
! ***********************************************************
......@@ -21,16 +21,15 @@ CONTAINS
USE m_rotate_mt_den_tofrom_local
USE m_sfTests
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_field), INTENT(INOUT) :: field
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_field), INTENT(INOUT) :: field
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_potden),INTENT(INOUT) :: vTot,vCoul,denRot
......@@ -41,8 +40,8 @@ CONTAINS
TYPE(t_potden) :: div, phi, checkdiv
TYPE(t_potden), DIMENSION(3) :: cvec, corrB, bxc
! Rescale vTot%pw_w with number of stars
IF (.NOT.noco%l_noco) THEN
DO js=1,SIZE(vtot%pw_w,2)
......@@ -67,10 +66,10 @@ CONTAINS
!CALL sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,bxc,div,phi,cvec,corrB,checkdiv)
!CALL correctPot(vTot,cvec)
!END IF
! ---> store v(l=0) component as r*v(l=0)/sqrt(4pi)
DO js = 1,input%jspins !Used input%jspins instead of SIZE(vtot%mt,4) since the off diag, elements of VTot%mt need no rescaling.
DO js = 1,input%jspins !Used input%jspins instead of SIZE(vtot%mt,4) since the off diag, elements of VTot%mt need no rescaling.
DO n = 1,atoms%ntype
vTot%mt(:atoms%jri(n),0,n,js) = atoms%rmsh(:atoms%jri(n),n)*vTot%mt(:atoms%jri(n),0,n,js)/sfp_const
ENDDO
......@@ -83,7 +82,7 @@ CONTAINS
END DO
END DO
!Copy first vacuum into second vacuum if this was not calculated before
!Copy first vacuum into second vacuum if this was not calculated before
IF (vacuum%nvac==1) THEN
vTot%vacz(:,2,:) = vTot%vacz(:,1,:)
IF (sym%invs) THEN
......@@ -92,6 +91,6 @@ CONTAINS
vTot%vacxy(:,:,2,:) = vTot%vacxy(:,:,1,:)
ENDIF
ENDIF
END SUBROUTINE vgen_finalize
END MODULE m_vgen_finalize
......@@ -21,7 +21,7 @@ MODULE m_xcBfield
PUBLIC :: makeVectorField, sourcefree, correctPot
CONTAINS
SUBROUTINE makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,denmat,factor,aVec,icut)
SUBROUTINE makeVectorField(sym,stars,atoms,sphhar,vacuum,input,noco,denmat,factor,aVec)
! Contructs the exchange-correlation magnetic field from the total poten-
! tial matrix or the magnetic density for the density matrix. Only used for
......@@ -89,7 +89,7 @@ CONTAINS
END SUBROUTINE makeVectorField
SUBROUTINE sourcefree(mpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,icut,div,phi,cvec,corrB,checkdiv)
SUBROUTINE sourcefree(mpi,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,aVec,div,phi,cvec,corrB,checkdiv)
USE m_vgen_coulomb
USE m_gradYlm
USE m_grdchlh
......@@ -124,7 +124,7 @@ CONTAINS
TYPE(t_potden) :: divloc
TYPE(t_atoms) :: atloc
INTEGER :: n, jr, lh, lhmax, jcut, nat
INTEGER :: n, jr, lh, lhmax, jcut, nat ,i
REAL :: xp(3,(atoms%lmaxd+1+mod(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1))
CALL div%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype, &
......
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