Start of new inpgen
Showing
inpgen/new/atompar.F90
0 → 100644
inpgen/new/bravais_symm.f90
0 → 100644
!-------------------------------------------------------------------------------- | ||
! 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_check_mt_radii | ||
USE m_juDFT | ||
!--------------------------------------------------------------------- | ||
! Check muffin tin radii and determine a reasonable choice for MTRs. | ||
!--------------------------------------------------------------------- | ||
CONTAINS | ||
SUBROUTINE check_mt_radii(atoms,input,vacuum,cell,oneD,l_test,rmt1,overlap) | ||
USE m_types | ||
USE m_sort | ||
USE m_inv3 | ||
USE m_juDFT | ||
IMPLICIT NONE | ||
! .. | ||
! .. Scalar Arguments .. | ||
TYPE(t_atoms),INTENT(IN) :: atoms | ||
TYPE(t_input),INTENT(IN) :: input | ||
TYPE(t_vacuum),INTENT(IN):: vacuum | ||
TYPE(t_cell),INTENT(IN) :: cell | ||
TYPE(t_oneD),INTENT(IN) :: oneD | ||
LOGICAL, INTENT (IN) :: l_test | ||
! .. | ||
! .. Array Arguments .. | ||
REAL, INTENT (OUT),OPTIONAL :: rmt1(atoms%ntype) | ||
REAL,OPTIONAL,INTENT(OUT):: overlap(0:atoms%ntype,atoms%ntype) | ||
! .. | ||
! .. Local Scalars .. | ||
INTEGER na,n | ||
INTEGER i,j,k,l | ||
INTEGER maxCubeAtoms, iAtom, numAtoms, iNeighborAtom, identicalAtoms | ||
INTEGER typeA, typeB | ||
REAL sum_r,facA,facB | ||
REAL rmtMax, rmtMin, rmtMaxDefault, rmtDelta | ||
REAL rmtFac, cubeLength, amatAuxDet | ||
REAL maxSqrDist, dist, currentDist | ||
LOGICAL error, outOfBounds | ||
! .. | ||
! .. Local Arrays .. | ||
REAL t_rmt(0:103), minRmts(0:103) | ||
REAL amatAux(3,3), invAmatAux(3,3) | ||
REAL taualAux(3,atoms%nat), posAux(3,atoms%nat) | ||
REAL minPos(3), maxPos(3), pos(3), point(3), realCellPos(3) | ||
REAL offsetPos(3) | ||
REAL nearestAtomDists(atoms%ntype) | ||
INTEGER nearestAtoms(atoms%ntype) | ||
INTEGER sortedDistList(atoms%ntype) | ||
INTEGER minCubeIndex(3), maxCubeIndex(3), cubeIndex(3) | ||
INTEGER minCellIndices(3), maxCellIndices(3) | ||
INTEGER, ALLOCATABLE :: numAtomsInCubes(:,:,:) | ||
INTEGER, ALLOCATABLE :: atomRefsInCubes(:,:,:,:) | ||
INTEGER, ALLOCATABLE :: refCubes(:,:) | ||
INTEGER, ALLOCATABLE :: nearestNeighbors(:,:) | ||
INTEGER, ALLOCATABLE :: numNearestNeighbors(:) | ||
INTEGER, ALLOCATABLE :: neighborAtoms(:) | ||
INTEGER, ALLOCATABLE :: distIndexList(:) | ||
REAL, ALLOCATABLE :: posInCubes(:,:,:,:,:) | ||
REAL, ALLOCATABLE :: refPos(:,:) | ||
REAL, ALLOCATABLE :: nearestNeighborDists(:,:) | ||
REAL, ALLOCATABLE :: sqrDistances(:) | ||
! Plan for this routine: | ||
! 0. Do initializations and set some constants | ||
! 1. Locally replace unit cell by an auxiliary unit cell with: | ||
! a) all atoms within the unit cell | ||
! b) basis vectors obtained by lattice reduction of the original cell. | ||
! [not in 1st (this) version of routine. Can be implemented with the LLL algorithm when needed.] | ||
! 2. Get minimal and maximal coordinates within auxiliary unit cell | ||
! 3. Construct mesh of cubes covering the auxiliary unit cell and a boundary of width 2*rmtMax + rmtDelta | ||
! 4. Fill mesh of cubes with atoms | ||
! a) Store atoms in cubes and representative cube for each atom type | ||
! 5. For each atom in auxiliary unit cell select cube and collect shortest distances to other atoms in neighborhood | ||
! a) Sort distances and set MT radii for the atoms | ||
! 6. Correct bad choices and set missing MT radii, vacuum distances, and other parameters | ||
! 7. Test old MT radii | ||
! 0. Do initializations and set some constants | ||
if (present(overlap)) overlap=0.0 | ||
rmtMaxDefault = 2.8 | ||
rmtMax = rmtMaxDefault | ||
rmtMin = 1.0 | ||
IF (l_test) THEN | ||
rmtMax = MAX(rmtMax,MAXVAL(atoms%rmt(:))) | ||
rmtMin = MIN(rmtMin,MINVAL(atoms%rmt(:))) | ||
END IF | ||
rmtDelta = 0.3 | ||
IF (input%film) THEN | ||
rmtFac = 0.95 | ||
ELSE | ||
rmtFac = 0.975 | ||
ENDIF | ||
t_rmt(0:103) = 2.3 ! default value | ||
t_rmt(1) = 1.0 ; t_rmt(5:9) = 1.3 ; t_rmt(16:17) = 1.8 | ||
cubeLength = 2*rmtMax+rmtDelta | ||
maxCubeAtoms = (FLOOR(cubeLength / (0.7*2.0*rmtMin)) + 1)**3 | ||
error = .FALSE. | ||
! 1. For the 1st version the auxiliary unit cell is just a copy of the original unit cell with | ||
! all atoms within the cell. | ||
DO i = 1, 3 | ||
DO j = 1, 3 | ||
amatAux(i,j) = cell%amat(i,j) | ||
END DO | ||
END DO | ||
DO i = 1, atoms%nat | ||
taualAux(1,i) = atoms%taual(1,i) - FLOOR(atoms%taual(1,i)) | ||
taualAux(2,i) = atoms%taual(2,i) - FLOOR(atoms%taual(2,i)) | ||
taualAux(3,i) = atoms%taual(3,i) - FLOOR(atoms%taual(3,i)) | ||
posAux(:,i) = MATMUL(amatAux,taualAux(:,i)) | ||
END DO | ||
! 2. Get minimal and maximal coordinates for auxiliary unit cell | ||
minPos = 0.0 | ||
maxPos = 0.0 | ||
DO i = 0, 1 | ||
DO j = 0, 1 | ||
DO k = 0, 1 | ||
DO l = 1, 3 | ||
pos(l) = i*amatAux(l,1) + j*amatAux(l,2) + k*amatAux(l,3) | ||
IF (pos(l).GT.maxPos(l)) maxPos(l) = pos(l) | ||
< |