abclocdn.F90 4.72 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,&
Gregor Michalicek's avatar
Gregor Michalicek committed
24
       ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force)
25

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

29
    IMPLICIT NONE
30 31 32 33 34 35

    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
36
    TYPE(t_mat),   INTENT(IN) :: zMat
37 38
    TYPE(t_force), OPTIONAL, INTENT(INOUT) :: force

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
    COMPLEX, INTENT (IN) :: phase
Gregor Michalicek's avatar
Gregor Michalicek committed
43
    LOGICAL, INTENT (IN) :: l_force
44

45
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
46
    REAL,    INTENT (IN) :: alo1(:),blo1(:),clo1(:)
47 48
    COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
    COMPLEX, INTENT (IN) :: ccchi(2)
Daniel Wortmann's avatar
Daniel Wortmann committed
49 50 51
    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)
52
    REAL,    OPTIONAL, INTENT (IN)    :: fgp(3)
53

54 55
    !     .. Local Scalars ..
    COMPLEX ctmp,term1
56
    INTEGER i,j,l,ll1,lm,nbasf,m,na2,lmp
57 58
    !     ..
    !     ..
Daniel Wortmann's avatar
Daniel Wortmann committed
59
    term1 = 2 * tpi_const/SQRT(cell%omtil) * ((atoms%rmt(ntyp)**2)/2) * phase
60 61 62 63
    !---> 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
64 65 66 67 68 69 70 71 72
    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
73
                ctmp = term1*CONJG(ylm(ll1+m+1))*ccchi(iintsp)*zMat%data_c((iintsp-1)*(lapw%nv(1)+atoms%nlotot)+nbasf,i)
Daniel Wortmann's avatar
Daniel Wortmann committed
74
             ELSE
75
                ctmp = term1*CONJG(ylm(ll1+m+1))*( ccchi(1)*zMat%data_c(nbasf,i)+ccchi(2)*zMat%data_c(lapw%nv(1)+atoms%nlotot+nbasf,i) )
Daniel Wortmann's avatar
Daniel Wortmann committed
76
             ENDIF
77
          ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
78
             IF (zMat%l_real) THEN
79
                ctmp = zMat%data_r(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
Daniel Wortmann's avatar
Daniel Wortmann committed
80
             ELSE
81
                ctmp = zMat%data_c(nbasf,i)*term1*CONJG(ylm(ll1+m+1))
Daniel Wortmann's avatar
Daniel Wortmann committed
82
             ENDIF
83
          ENDIF
84 85 86
          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)
87
          IF (atoms%invsat(na)==1.AND.noco%l_soc.AND.sym%invs) THEN
88 89 90 91 92 93 94
             ctmp = zMat%data_c(nbasf,i)*CONJG(term1)*ylm(ll1+m+1)*(-1)**(l-m)
             na2 = sym%invsatnr(na)
             lmp = ll1 - m
             acof(i,lmp,na2) = acof(i,lmp,na2) +ctmp*alo1(lo)
             bcof(i,lmp,na2) = bcof(i,lmp,na2) +ctmp*blo1(lo)
             ccof(-m,i,lo,na2) = ccof(-m,i,lo,na2) +ctmp*clo1(lo)
          ENDIF
Gregor Michalicek's avatar
Gregor Michalicek committed
95
          IF (l_force) THEN
96 97
             force%acoflo(m,i,lo,na) = force%acoflo(m,i,lo,na) + ctmp*alo1(lo)
             force%bcoflo(m,i,lo,na) = force%bcoflo(m,i,lo,na) + ctmp*blo1(lo)
98
             DO j = 1,3
99 100 101
                force%aveccof(j,i,lm,na)   = force%aveccof(j,i,lm,na)   + fgp(j)*ctmp*alo1(lo)
                force%bveccof(j,i,lm,na)   = force%bveccof(j,i,lm,na)   + fgp(j)*ctmp*blo1(lo)
                force%cveccof(j,m,i,lo,na) = force%cveccof(j,m,i,lo,na) + fgp(j)*ctmp*clo1(lo)
102 103
             END DO
          END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
104
       END DO
105
    END DO 
Daniel Wortmann's avatar
Daniel Wortmann committed
106
  
107 108
  END SUBROUTINE abclocdn
END MODULE m_abclocdn