Commit 05782dbc authored by Daniel Wortmann's avatar Daniel Wortmann

Cleanup. Removed a lot of files no longer compiled and/or used.

parent b8bb564e
set(fleur_F77 ${fleur_F77}
)
set(fleur_F90 ${fleur_F90}
cdn_mt/abccoflo.f90
#cdn_mt/abccoflo.f90
cdn_mt/abclocdn.F90
cdn_mt/abclocdn1.F90
cdn_mt/abclocdn_pulay.F90
#cdn_mt/abclocdn_pulay.F90
cdn_mt/abcof.F90
cdn_mt/abcof3.F90
cdn_mt/abcrot2.f90
......@@ -24,10 +24,9 @@ cdn_mt/rhonmt.f90
cdn_mt/rhonmt21.f90
cdn_mt/rhonmtlo.f90
cdn_mt/rhosphnlo.f90
cdn_mt/setabc1locdn.f90
#cdn_mt/setabc1locdn.f90
cdn_mt/setabc1locdn1.f90
cdn_mt/calcDenCoeffs.f90
cdn_mt/magnMomFromDen.f90
cdn_mt/alignSpinAxisMagn.f90
)
......@@ -14,7 +14,7 @@ core/inconi.f
core/inconz.f
core/kernel1.f
core/kernel2.f
core/nshell.f
#core/nshell.f
core/nwrfst.f
core/rinvgj.f
core/rsimp.f
......@@ -25,5 +25,4 @@ core/ccdnup.f90
core/cored.F90
core/coredr.F90
core/etabinit.F90
#core/setcor.f90
)
MODULE m_calc_tetra
!Calculate tetraeder from equidistant grid ref Phys. Rev. B 49, (16223).
!Largely equivalent to spex routines
CONTAINS
SUBROUTINE calc_tetra(kpts,cell,input,sym)
USE m_types
USE m_juDFT
USE m_constants
IMPLICIT NONE
TYPE(t_kpts), INTENT(INOUT) :: kpts
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
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
REAL sumvol,volbz
INTEGER, ALLOCATABLE :: itet(:,:)
REAL, ALLOCATABLE :: vtet(:)
CALL timestart("Calculation of Tetrahedra")
volbz = ABS(det(cell%bmat))
!Choose the tetrahedra decomposition along the shortest diagonal
CALL get_tetra(kpts,cell,ntetra,vol,tetra)
!MISSING: Generate all kpts
!Set up pointer array for the kpts
p = 0
DO ikpt = 1, kpts%nkptf
iarr = nint(kpts%bkf(:,ikpt)*kpts%nkpt3)
p(iarr(1),iarr(2),iarr(3)) = ikpt
ENDDO
p(kpts%nkpt3(1),:,:) = p(0,:,:)
p(:,kpts%nkpt3(2),:) = p(:,0,:)
p(:,:,kpts%nkpt3(3)) = p(:,:,0)
!Check for invalid indices
IF(ANY(p<=0).OR.ANY(p>kpts%nkptf)) CALL juDFT_error("Invalid kpoint index in pointer array",calledby="calc_tetra")
IF (ALLOCATED(kpts%ntetra)) THEN
DEALLOCATE(kpts%ntetra)
END IF
IF (ALLOCATED(kpts%voltet)) THEN
DEALLOCATE(kpts%voltet)
END IF
ALLOCATE(kpts%ntetra(4,kpts%nkptf*6))
ALLOCATE(kpts%voltet(kpts%nkptf*6))
kpts%ntet = 0
sumvol = 0.0
!Set up the tetrahedrons
DO k3 = 0, kpts%nkpt3(3)-1
DO k2 = 0, kpts%nkpt3(2)-1
DO k1 = 0, kpts%nkpt3(1)-1
!Corners of the current cube
kcorn(1) = p(k1 ,k2 ,k3 )
kcorn(2) = p(k1+1,k2 ,k3 )
kcorn(3) = p(k1 ,k2+1,k3 )
kcorn(4) = p(k1+1,k2+1,k3 )
kcorn(5) = p(k1 ,k2 ,k3+1)
kcorn(6) = p(k1+1,k2 ,k3+1)
kcorn(7) = p(k1 ,k2+1,k3+1)
kcorn(8) = p(k1+1,k2+1,k3+1)
!Now write the information about the tetrahedron into the corresponding arrays in kpts
DO itetra = 1, ntetra
!Drop all tetrahedra without kpoints inside the IBZ
sumvol = sumvol + vol
IF(ALL(kcorn(tetra(1:4,itetra)).GT.kpts%nkpt)) CYCLE
kpts%ntet = kpts%ntet+1
kpts%ntetra(1:4,kpts%ntet) = kcorn(tetra(1:4,itetra))
kpts%voltet(kpts%ntet) = vol
ENDDO
ENDDO
ENDDO
ENDDO
IF(ABS(sumvol-volbz).GT.1E-12) CALL juDFT_error("calc_tetra failed", calledby="calc_tetra")
input%gfTet = .TRUE.
kpts%voltet = kpts%voltet/volbz
!Reallocate the tetraeder arrays
ALLOCATE(itet(4,kpts%ntet))
itet = kpts%ntetra(1:4,1:kpts%ntet)
DEALLOCATE(kpts%ntetra)
ALLOCATE(kpts%ntetra(4,kpts%ntet))
kpts%ntetra = itet
ALLOCATE(vtet(kpts%ntet))
vtet = kpts%voltet(1:kpts%ntet)
DEALLOCATE(kpts%voltet)
ALLOCATE(kpts%voltet(kpts%ntet))
kpts%voltet = vtet
CALL timestop("Calculation of Tetrahedra")
END SUBROUTINE calc_tetra
SUBROUTINE get_tetra(kpts,cell,ntetra,vol,tetra)
USE m_types
IMPLICIT NONE
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_cell), INTENT(IN) :: cell
INTEGER, INTENT(OUT) :: ntetra
REAL, INTENT(OUT) :: vol
INTEGER, INTENT(OUT) :: tetra(:,:)
REAL rlv(3,3),diag(4),d(3)
INTEGER idmin
!Calculate the lengths of the three diagonals
rlv(:,1) = cell%bmat(:,1) / kpts%nkpt3
rlv(:,2) = cell%bmat(:,2) / kpts%nkpt3
rlv(:,3) = cell%bmat(:,3) / kpts%nkpt3
vol = 1/6.0*ABS(det(rlv))
d = rlv(:,1) + rlv(:,3) - rlv(:,2)
diag(1) = sum(d*d)
d = rlv(:,2) + rlv(:,3) - rlv(:,1)
diag(2) = sum(d*d)
d = rlv(:,1) + rlv(:,2) + rlv(:,3)
diag(3) = sum(d*d)
d = rlv(:,1) + rlv(:,2) - rlv(:,3)
diag(4) = sum(d*d)
idmin = minloc(diag,1)
ntetra = 0
!From spex tetrahedron.f (For now we only choose one decomposition)
if(idmin==1) then
tetra(:,ntetra+1:ntetra+6) = reshape ( [ 1,2,3,6, 5,7,3,6, 1,5,3,6, 2,4,3,6, 4,8,3,6, 7,8,3,6 ], [ 4,6 ] )
ntetra = ntetra + 6
endif
if(idmin==2) then
tetra(:,ntetra+1:ntetra+6) = reshape ( [ 5,6,2,7, 1,5,2,7, 1,3,2,7, 8,6,2,7, 4,3,2,7, 8,4,2,7 ], [ 4,6 ] )
ntetra = ntetra + 6
endif
if(idmin==3) then
tetra(:,ntetra+1:ntetra+6) = reshape ( [ 2,6,1,8, 2,4,1,8, 3,4,1,8, 3,7,1,8, 5,7,1,8, 5,6,1,8 ], [ 4,6 ] )
ntetra = ntetra + 6
endif
if(idmin==4) then
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
END SUBROUTINE get_tetra
REAL FUNCTION det(m)
REAL m(:,:)
det = m(1,1)*m(2,2)*m(3,3) + m(1,2)*m(2,3)*m(3,1) + &
m(2,1)*m(3,2)*m(1,3) - m(1,3)*m(2,2)*m(3,1) - &
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
......@@ -26,7 +26,6 @@ CONTAINS
TYPE(t_stars),INTENT(INOUT) :: stars
TYPE(t_atoms),INTENT(INOUT) :: atoms
TYPE(t_sphhar),INTENT(INOUT) :: sphhar
TYPE(t_dimension),INTENT(INOUT) :: dimension
TYPE(t_vacuum),INTENT(INOUT) :: vacuum
TYPE(t_obsolete),INTENT(INOUT) :: obsolete
TYPE(t_kpts),INTENT(INOUT) :: kpts
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_plotdop
use m_juDFT
use m_types
!+++++++++++++++++++++++++++++++++++++++++++++++++
! plot the charge density for fleur code output
!
! if twodim = .false. a 3-D plot with nplot layers in z-direction
! is constructed; the 3x3 matrix gives the 3 vectors of the cell ..
! .gustav
!
! Changed the input/output for easier use.
! This subroutine uses the file plot_inp for input.
! The old plotin-file is still supported by the old subroutine at the
! end of the module
! Juelich, 21.1.06 DW
!
! +++++++++++++++++++++++++++++++++++++++++++++++++
CONTAINS
SUBROUTINE plotdop(oneD,stars,vacuum,sphhar,atoms,&
input,sym,cell,sliceplot,noco,cdnfname)
USE m_outcdn
USE m_loddop
USE m_xsf_io
USE m_cdn_io
USE m_constants
IMPLICIT NONE
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_input), INTENT(IN) :: input
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sliceplot), INTENT(IN) :: sliceplot
TYPE(t_noco), INTENT(IN) :: noco
CHARACTER(len=10), OPTIONAL, INTENT(IN) :: cdnfname
! .. Local Scalars ..
REAL :: tec,qint,fermiEnergyTemp,phi0,angss
INTEGER :: i,j,ix,iy,iz,jsp,na,nplo,iv,iflag,nfile
INTEGER :: nplot,nt,jm,jspin,numInFiles,numOutFiles
LOGICAL :: twodim,oldform,newform,l_qfix
LOGICAL :: cartesian,xsf,unwind,polar
! .. Local Arrays ..
TYPE(t_potden), ALLOCATABLE :: den(:)
REAL, ALLOCATABLE :: xdnout(:)
REAL :: pt(3),vec1(3),vec2(3),vec3(3),zero(3),help(3),qssc(3)
INTEGER :: grid(3)
REAL :: rhocc(atoms%jmtd)
REAL :: point(3)
CHARACTER (len=10), ALLOCATABLE :: cdnFilenames(:)
CHARACTER (len=15), ALLOCATABLE :: outFilenames(:)
CHARACTER (len=30) :: filename
CHARACTER (len=7) :: textline
end subroutine
END MODULE m_plotdop
......@@ -323,7 +323,6 @@ CONTAINS
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'
......
set(fleur_F77 ${fleur_F77}
#force/relax.F
)
set(fleur_F90 ${fleur_F90}
#force/bfgs0.f90
#force/bfgs.f90
force/force_b8.f90
#force/force_0.f90
force/force_a12.f90
force/force_a21.F90
force/force_a21_U.f90
force/force_a21_lo.f90
force/force_a3.f90
force/force_a4.f90
force/force_a4_add.f90
#force/force_a4_add.f90
force/force_a8.F90
force/force_b8.f90
force/force_sf.F90
#force/force_sf.F90
force/force_w.F90
force/fix_by_gaussian.F90
#force/geo.f90
force/stern.f90
force/relaxation.F90
)
......@@ -7,7 +7,6 @@ global/radsra.f
global/radsrd.F
global/radsrdn.f
global/soc_sym.f
global/ss_sym.f
global/starf.f
global/triang.f
global/vacudz.f
......@@ -18,7 +17,7 @@ global/differ.f
set(fleur_F90 ${fleur_F90}
global/savewigner.f90
#global/differ.f90
global/matrix_copy.F90
#global/matrix_copy.F90
global/checkdop.F90
global/checkdopall.f90
global/sort.f90
......@@ -35,4 +34,4 @@ if (FLEUR_USE_GPU)
set(fleur_F90 ${fleur_F90}
global/nvtx.F90
)
endif()
endif()
set(fleur_F77 ${fleur_F77}
init/bandstr1.F
#init/bandstr1.F
init/boxdim.f
#init/convn_dim.f
init/gtest.f
init/ifft235.f
init/lhcal.f
init/local_sym.f
init/mod_symdata.f
#init/mod_symdata.f
init/od_chisym.f
init/prp_xcfft_box.f
init/ptsym.f
......
......@@ -28,6 +28,8 @@ read_inpgen_input.f90
super_check.f90
make_kpoints.f90
read_old_inp.f90
ss_sym.f
mod_symdata.f
old_inp/apws_dim.f90
old_inp/dimen7.F90
old_inp/dimens.F90
......@@ -42,6 +44,7 @@ old_inp/setup.f90
old_inp/rw_noco.f90
old_inp/rw_symfile.f
old_inp/spg2set.f
old_inp/inpeig.f90
${FLEUR_SRC}/init/compile_descr.F90
${FLEUR_SRC}/global/sort.f90
......@@ -99,8 +102,6 @@ ${FLEUR_SRC}/cdn_mt/rhonmt21.f90
${FLEUR_SRC}/xc-pot/gaunt.f90
${FLEUR_SRC}/math/grule.f90
${FLEUR_SRC}/init/ifft235.f
${FLEUR_SRC}/init/mod_symdata.f
${FLEUR_SRC}/init/inpeig.f90
${FLEUR_SRC}/kpoints/gkptwgt.f90
${FLEUR_SRC}/init/local_sym.f
${FLEUR_SRC}/init/lhcal.f
......@@ -113,7 +114,6 @@ ${FLEUR_SRC}/global/utility.F90
${FLEUR_SRC}/global/radsra.f
${FLEUR_SRC}/global/differ.f
${FLEUR_SRC}/global/soc_sym.f
${FLEUR_SRC}/global/ss_sym.f
${FLEUR_SRC}/math/inwint.f
${FLEUR_SRC}/math/outint.f
${FLEUR_SRC}/math/intgr.F90
......
......@@ -26,7 +26,6 @@
USE m_types_stars
USE m_types_atoms
USE m_types_sphhar
USE m_types_dimension
USE m_types_vacuum
USE m_types_kpts
USE m_types_oneD
......
......@@ -19,7 +19,6 @@ CONTAINS
USE m_types_stars
USE m_types_atoms
USE m_types_sphhar
USE m_types_dimension
USE m_types_vacuum
USE m_types_kpts
USE m_types_oned
......@@ -33,7 +32,7 @@ CONTAINS
TYPE(t_stars),INTENT(INOUT) :: stars
TYPE(t_atoms),INTENT(INOUT) :: atoms
TYPE(t_sphhar),INTENT(INOUT) :: sphhar
TYPE(t_vacuum),INTENT(INOUT) :: vacuum
TYPE(t_kpts),INTENT(INOUT) :: kpts
TYPE(t_oneD),INTENT(INOUT) :: oneD
......
......@@ -12,7 +12,6 @@ CONTAINS
sliceplot,banddos,enpara,xcpot,kpts,hybrid,&
oneD,grid)
USE m_types_input
USE m_types_dimension
USE m_types_atoms
USE m_types_sphhar
USE m_types_cell
......
......@@ -13,7 +13,6 @@
USE m_types_noco
USE m_types_oneD
USE m_types_kpts
USE m_types_dimension
USE m_types_stars
use m_apwsdim
IMPLICIT NONE
......@@ -21,7 +20,7 @@
TYPE(t_cell),INTENT(INOUT) :: cell
TYPE(t_noco),INTENT(INOUT) :: noco
TYPE(t_stars),INTENT(INOUT) :: stars
TYPE(t_kpts),INTENT(INOUT) :: kpts
TYPE(t_oneD),INTENT(INOUT) :: oneD
CHARACTER(len=*),INTENT(IN) :: latnam
......@@ -101,7 +100,7 @@
stars%kq2_fft = MAX(kq2,stars%kq2_fft)
stars%kq3_fft = MAX(kq3,stars%kq3_fft)
ENDDO ! k=pts
REWIND(41)
READ (41,*)
......
set(fleur_F77 ${fleur_F77}
kpoints/bravais.f
kpoints/brzone.f
kpoints/divi.f
kpoints/fulstar.f
kpoints/kprep.f
kpoints/kptmop.f
kpoints/kpttet.f
kpoints/kvecon.f
kpoints/od_kptsgen.f
kpoints/ordstar.f
kpoints/tetcon.f
kpoints/kptgen_hybrid.f
)
set(fleur_F90 ${fleur_F90}
kpoints/gkptwgt.f90
kpoints/unfoldBandKPTS.f90
kpoints/brzone2.f90
)
......@@ -2,11 +2,9 @@ set(fleur_F77 ${fleur_F77}
)
set(fleur_F90 ${fleur_F90}
ldau/sgaunt.f90
ldau/u_ham.F90
ldau/u_setup.f90
ldau/uj2f.f90
ldau/umtx.f90
ldau/v_mmp.F90
ldau/v_mmp21.F90
ldau/u_ham21.F90
)
......@@ -115,7 +115,7 @@ CONTAINS
! local scalars
INTEGER :: eig_id,archiveType, num_threads
INTEGER :: iter,iterHF,i
INTEGER :: iter,iterHF,i,n
INTEGER :: wannierspin
LOGICAL :: l_opti,l_cont,l_qfix,l_real
REAL :: fix
......
......@@ -23,7 +23,7 @@ CONTAINS
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
TYPE(t_atoms), INTENT(IN) :: atoms
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_input), INTENT(IN) :: input
......@@ -37,7 +37,7 @@ CONTAINS
! .. Local Scalars ..
REAL c, d, delrv, dist, distol, e, fisr, fj, fl, fn, h,&
& p, p1, pmax, pmin, r, r3, rn, rnot, z, zero, bmu_l, rho
INTEGER i, inr0, it, itmax, k, l, n, ispin, kk, ierr, msh_l
INTEGER i, inr0, it, itmax, k, l, n, ispin, kk, ierr, msh_l,isp
LOGICAL conv, lastit, l_start
! ..
! .. Local Arrays ..
......@@ -79,6 +79,18 @@ CONTAINS
!CALL setcor(ntyp, input%jspins, atoms, input, bmu_l, nst, kappa, nprnc, occ)
CALL atoms%econf(ntyp)%get_core(nst,nprnc,kappa,occ,l_valence)
if (input%jspins == 2) THEN
bmu_l=sign(1.,sum(occ(:nst,1)-occ(:nst,2)))
if (any(bmu_l*(occ(:nst,1)-occ(:nst,2))<-1.E-5)) call judft_warn("Inconsistent polarization of starting density")
if (bmu_l<0) THEN
DO i=1,nst
bmu_l=occ(i,1)
occ(i,1)=occ(i,2)
occ(i,2)=bmu_l
ENDDO
bmu_l=-1
ENDIF
ENDIF
!
!---> for electric field case (sigma.ne.0), add the extra charge
!---> to the uppermost level; ignore the possible problem that
......@@ -262,8 +274,9 @@ CONTAINS
conv = .false.
! list eigenvalues
190 IF (conv) WRITE (6, FMT=8040) it, dist
DO ispin = 1, input%jspins
WRITE (6, '(a8,i2)') 'spin No.', ispin
DO isp = 1, input%jspins
ispin=merge(isp,3-isp,bmu_l>0)
WRITE (6, '(a8,i2)') 'spin No.',ispin
DO k = 1, nst
fj = iabs(kappa(k)) - 0.5e0
l = fj + 0.5e0*isign(1, kappa(k)) + 0.01e0
......@@ -286,5 +299,18 @@ CONTAINS
8050 FORMAT(3x, i1, i5, i5, f6.1, 2(3x, f7.2, 1x, 2f12.6))
8060 FORMAT('it,dist,p=', i4, 2f12.5)
IF (bmu_l<0) THEN
DO i=1,nst
bmu_l=eig(i,1)
eig(i,1)=eig(i,2)
eig(i,2)=bmu_l
ENDDO
DO i=1,size(rhoss,1)
bmu_l=rhoss(i,1)
rhoss(1,i)=rhoss(2,i)
rhoss(2,i)=bmu_l
ENDDO
ENDIF
END SUBROUTINE atom2
END MODULE m_atom2
This diff is collapsed.
......@@ -46,7 +46,7 @@ vgen/vvacxcg.f90
vgen/vvacxy.f90
vgen/b_field.F90
vgen/write_xcstuff.f90
vgen/xy_av_den.f90
#vgen/xy_av_den.f90
vgen/VYukawaFilm.f90
vgen/divergence.f90
vgen/xcBfield.f90
......
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