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) | ||
| < |