abclocdn.F90 4.52 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
MODULE m_abclocdn
  USE m_juDFT
  !*********************************************************************
  ! Calculates the (upper case) A, B and C coefficients for the local
  ! orbitals. The difference to abccoflo is, that a summation over the
  ! Gs ist performed. The A, B and C coeff. are set up for each eigen-
  ! state.
  ! Philipp Kurz 99/04
  !*********************************************************************
  !*************** ABBREVIATIONS ***************************************
  ! nkvec   : stores the number of G-vectors that have been found and
  !           accepted during the construction of the local orbitals.
  ! kvec    : k-vector used in hssphn to attach the local orbital 'lo'
  !           of atom 'na' to it.
  !*********************************************************************
CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
23
  SUBROUTINE abclocdn(atoms,sym,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
24 25 26
       ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,&
       fgp,acoflo,bcoflo,aveccof,bveccof,cveccof)

27
    USE m_types
Daniel Wortmann's avatar
Daniel Wortmann committed
28
    USE m_constants
29

30
    IMPLICIT NONE
31 32 33 34 35 36 37

    TYPE(t_noco),  INTENT(IN) :: noco
    TYPE(t_sym),   INTENT(IN) :: sym
    TYPE(t_atoms), INTENT(IN) :: atoms
    TYPE(t_lapw),  INTENT(IN) :: lapw
    TYPE(t_cell),  INTENT(IN) :: cell
    TYPE(t_zMat),  INTENT(IN) :: zMat
38 39
    !     ..
    !     .. Scalar Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
40 41
    INTEGER, INTENT (IN) :: iintsp
    INTEGER, INTENT (IN) :: k,na,ne,ntyp,nkvec,lo
42 43 44
    COMPLEX, INTENT (IN) :: phase
    !     ..
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
45
    REAL,    INTENT (IN) :: alo1(:),blo1(:),clo1(:)
46 47
    COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
    COMPLEX, INTENT (IN) :: ccchi(2)
Daniel Wortmann's avatar
Daniel Wortmann committed
48 49 50
    COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
    COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
    COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
51 52 53 54 55 56
    REAL,    OPTIONAL, INTENT (IN)    :: fgp(3)
    COMPLEX, OPTIONAL, INTENT (INOUT) :: acoflo(-atoms%llod:,:,:,:)
    COMPLEX, OPTIONAL, INTENT (INOUT) :: bcoflo(-atoms%llod:,:,:,:)
    COMPLEX, OPTIONAL, INTENT (INOUT) :: aveccof(:,:,0:,:)
    COMPLEX, OPTIONAL, INTENT (INOUT) :: bveccof(:,:,0:,:)
    COMPLEX, OPTIONAL, INTENT (INOUT) :: cveccof(:,-atoms%llod:,:,:,:)
57 58 59
    !     ..
    !     .. Local Scalars ..
    COMPLEX ctmp,term1
60
    INTEGER i,j,l,ll1,lm,nbasf,m
61 62
    !     ..
    !     ..
Daniel Wortmann's avatar
Daniel Wortmann committed
63
    term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase
64 65 66 67
    !---> the whole program is in hartree units, therefore 1/wronskian is
    !---> (rmt**2)/2. the factor i**l, which usually appears in the a, b
    !---> and c coefficients, is included in the t-matrices. thus, it does
    !---> not show up in the formula above.
Daniel Wortmann's avatar
Daniel Wortmann committed
68 69 70 71 72 73 74 75 76 77 78 79 80
    l = atoms%llo(lo,ntyp)
    ll1 = l* (l+1)
    nbasf=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvec
    DO i = 1,ne
       DO m = -l,l
          lm = ll1 + m
          !+gu_con
          IF (noco%l_noco) THEN
             IF (noco%l_ss) THEN
                ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i)
             ELSE
                ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%z_c(nbasf,i)+ccchi(2)*zMat%z_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
             ENDIF
81
          ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
82 83 84 85 86
             IF (zMat%l_real) THEN
                ctmp = zMat%z_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
             ELSE
                ctmp = zMat%z_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
             ENDIF
87
          ENDIF
88 89 90 91 92 93 94 95 96 97 98 99
          acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo)
          bcof(i,lm,na) = bcof(i,lm,na) + ctmp*blo1(lo)
          ccof(m,i,lo,na) = ccof(m,i,lo,na) + ctmp*clo1(lo)
          IF (PRESENT(aveccof)) THEN
             acoflo(m,i,lo,na) = acoflo(m,i,lo,na) + ctmp*alo1(lo)
             bcoflo(m,i,lo,na) = bcoflo(m,i,lo,na) + ctmp*blo1(lo)
             DO j = 1,3
                aveccof(j,i,lm,na)   = aveccof(j,i,lm,na)   + fgp(j)*ctmp*alo1(lo)
                bveccof(j,i,lm,na)   = bveccof(j,i,lm,na)   + fgp(j)*ctmp*blo1(lo)
                cveccof(j,m,i,lo,na) = cveccof(j,m,i,lo,na) + fgp(j)*ctmp*clo1(lo)
             END DO
          END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
100
       END DO
101
    END DO 
Daniel Wortmann's avatar
Daniel Wortmann committed
102
  
103 104
  END SUBROUTINE abclocdn
END MODULE m_abclocdn