Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_abclocdn1
       8             :   !*********************************************************************
       9             :   ! Calculates the basis coeffcients (bascof_lo) for the local
      10             :   ! orbitals. 
      11             :   !*********************************************************************
      12             :   !*************** ABBREVIATIONS ***************************************
      13             :   ! nkvec   : stores the number of G-vectors that have been found and
      14             :   !           accepted during the construction of the local orbitals.
      15             :   ! kvec    : k-vector used in hssphn to attach the local orbital 'lo'
      16             :   !           of atom 'na' to it.
      17             :   !*********************************************************************
      18             : CONTAINS
      19           0 :   SUBROUTINE abclocdn1(atoms,sym, con1,phase,ylm,ntyp,na,k,s,&
      20           0 :        nbasf0,alo1,blo1,clo1,kvec, nkvec,enough,bascof_lo )
      21             :     !
      22             :     USE m_types
      23             :     USE m_constants
      24             :     IMPLICIT NONE
      25             :     TYPE(t_sym),INTENT(IN)     :: sym
      26             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      27             :     !     ..
      28             :     !     .. Scalar Arguments ..
      29             :     INTEGER, INTENT (IN) :: k,na,ntyp
      30             :     REAL,    INTENT (IN) :: con1 ,s
      31             :     COMPLEX, INTENT (IN) :: phase
      32             :     !     ..
      33             :     !     .. Array Arguments ..
      34             :     INTEGER, INTENT (IN) :: nbasf0(atoms%nlod,atoms%nat) 
      35             :     REAL,    INTENT (IN) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
      36             :     REAL,    INTENT (IN) :: clo1(atoms%nlod,atoms%ntype)
      37             :     COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
      38             :     INTEGER, INTENT (IN) :: kvec(2*(2*atoms%llod+1) ,atoms%nlod)
      39             :     LOGICAL, INTENT (OUT) :: enough(atoms%nat)
      40             :     COMPLEX, INTENT (INOUT) :: bascof_lo(3,-atoms%llod:atoms%llod,4*atoms%llod+2,atoms%nlod,atoms%nat)
      41             :     INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%nat)
      42             : 
      43             :     !     ..
      44             :     !     .. Local Scalars ..
      45             :     COMPLEX ctmp,term1
      46             :     REAL,PARAMETER:: linindq=1.0e-4,eps=1.0e-30
      47             :     INTEGER i,l,ll1,lm,lo ,mind,nbasf,na2,lmp,m
      48             :     LOGICAL linind
      49             :     !     ..
      50             :     !     .. Local Arrays ..
      51           0 :     COMPLEX clotmp(-atoms%llod:atoms%llod)
      52             :     !     ..
      53           0 :     enough(na) = .TRUE.
      54           0 :     term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
      55             : 
      56             :     !---> the whole program is in hartree units, therefore 1/wronskian is
      57             :     !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
      58             :     !---> and c coefficients, is included in the t-matrices. thus, it does
      59             :     !---> not show up in the formula above.
      60           0 :     DO lo = 1,atoms%nlo(ntyp)
      61           0 :        l = atoms%llo(lo,ntyp)
      62           0 :        IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
      63           0 :           IF (sym%invsat(na).EQ.0) THEN
      64             : 
      65           0 :              IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
      66           0 :                 enough(na) = .FALSE.
      67           0 :                 nkvec(lo,na) = nkvec(lo,na) + 1
      68           0 :                 nbasf = nbasf0(lo,na) + nkvec(lo,na)
      69           0 :                 l = atoms%llo(lo,ntyp)
      70           0 :                 ll1 = l* (l+1)
      71           0 :                 DO m = -l,l
      72           0 :                    clotmp(m) = term1*CONJG(ylm(ll1+m+1))
      73             :                 END DO
      74           0 :                 IF ( kvec(nkvec(lo,na),lo) == k ) THEN
      75           0 :                    DO m = -l,l
      76           0 :                       lm = ll1 + m
      77             :                       !WRITE(*,*) 'nkvec(lo,na)',nkvec(lo,na)
      78             :                       bascof_lo(1,m,nkvec(lo,na),lo,na) =&
      79           0 :                            &                                           clotmp(m)*alo1(lo,ntyp)
      80             :                       bascof_lo(2,m,nkvec(lo,na),lo,na) =&
      81           0 :                            &                                           clotmp(m)*blo1(lo,ntyp)
      82             :                       bascof_lo(3,m,nkvec(lo,na),lo,na) =&
      83           0 :                            &                                           clotmp(m)*clo1(lo,ntyp)
      84             :                    END DO
      85             :                 ELSE
      86           0 :                    nkvec(lo,na) = nkvec(lo,na) - 1
      87             :                 ENDIF ! linind
      88             :              ENDIF   ! nkvec < 2*atoms%llo
      89             : 
      90           0 :           ELSEIF (sym%invsat(na).EQ.1) THEN
      91           0 :              IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
      92           0 :                 enough(na) = .FALSE.
      93           0 :                 nkvec(lo,na) = nkvec(lo,na) + 1
      94           0 :                 nbasf = nbasf0(lo,na) + nkvec(lo,na)
      95           0 :                 l = atoms%llo(lo,ntyp)
      96           0 :                 ll1 = l* (l+1)
      97           0 :                 DO m = -l,l
      98           0 :                    clotmp(m) = term1*CONJG(ylm(ll1+m+1))
      99             :                 END DO
     100           0 :                 IF ( kvec(nkvec(lo,na),lo) == k ) THEN
     101           0 :                    DO m = -l,l
     102           0 :                       lm = ll1 + m
     103           0 :                       bascof_lo(1,m,nkvec(lo,na),lo,na) = clotmp(m)*alo1(lo,ntyp)
     104           0 :                       bascof_lo(2,m,nkvec(lo,na),lo,na) = clotmp(m)*blo1(lo,ntyp)
     105           0 :                       bascof_lo(3,m,nkvec(lo,na),lo,na) = clotmp(m)*clo1(lo,ntyp)
     106             :                    ENDDO  ! m
     107             :                 ELSE       
     108           0 :                    nkvec(lo,na) = nkvec(lo,na) - 1
     109             :                 ENDIF       ! linind
     110             :              ENDIF         ! nkvec < 2*atoms%llo
     111             :           ELSE
     112           0 :              STOP 'invsat =/= 0 or 1'
     113             :           ENDIF
     114             :        ELSE
     115           0 :           enough(na) = .FALSE.
     116             :        ENDIF  ! s > eps  & l >= 1
     117             :     END DO
     118           0 :   END SUBROUTINE abclocdn1
     119             : END MODULE m_abclocdn1