rhonmt21.f90 4.32 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 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
MODULE m_rhonmt21
  !     *************************************************************
  !     subroutine sets up the coefficients of the spin (up,down) 
  !     part of the non-spherical muffin-tin density. 
  !                                                 pk`00 ff`01 gb`02
  !     *************************************************************
CONTAINS
  SUBROUTINE rhonmt21(atoms,llpd,sphhar, we,ne,sym,&
       acof,bcof, uunmt21,ddnmt21,udnmt21,dunmt21)
    USE m_gaunt,ONLY:gaunt1
    USE m_types
    IMPLICIT NONE
    TYPE(t_sym),INTENT(IN)     :: sym
    TYPE(t_sphhar),INTENT(IN)  :: sphhar
    TYPE(t_atoms),INTENT(IN)   :: atoms
    !     ..
    !     .. Scalar Arguments ..
    INTEGER,INTENT(IN) :: llpd    
    INTEGER,INTENT(IN) :: ne   
    !     ..
    !     .. Array Arguments ..
    COMPLEX, INTENT(IN) :: acof(:,0:,:,:)!(nobd,0:lmaxd* (lmaxd+2),natd,jspd)
    COMPLEX, INTENT(IN) :: bcof(:,0:,:,:)
    REAL,    INTENT(IN) :: we(:)!(nobd)
    COMPLEX, INTENT (INOUT) :: ddnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntypd  )
    COMPLEX, INTENT (INOUT) :: dunmt21((atoms%lmaxd+1)**2 ,sphhar%nlhd,atoms%ntypd )
    COMPLEX, INTENT (INOUT) :: udnmt21((atoms%lmaxd+1)**2 ,sphhar%nlhd,atoms%ntypd )
    COMPLEX, INTENT (INOUT) :: uunmt21((atoms%lmaxd+1)**2 ,sphhar%nlhd,atoms%ntypd )
    !     ..
    !     .. Local Scalars ..
    COMPLEX coef, cconst, cil, coef1
    COMPLEX, PARAMETER :: mi = (0.0,-1.0)
    INTEGER jmem,l,lh,llp,lm,lmp,lp,lv,m, mp,mv,na,natom,nb,nn,ns,nt
    !     ..
    !
    DO ns=1,sym%nsymt
       natom= 0
       DO nn=1,atoms%ntype
          nt= natom
          DO na= 1,atoms%neq(nn)
             nt= nt+1
             IF (atoms%ntypsy(nt)==ns) THEN

                DO lh = 1,sphhar%nlh(ns)
                   lv = sphhar%llh(lh,ns)
                   DO lp = 0,atoms%lmax(nn)
                      DO l = 0,atoms%lmax(nn)

                         IF ( MOD(lv+l+lp,2) == 0 ) THEN
                            cil = mi**(l-lp)
                            llp= lp*(atoms%lmax(nn)+1)+l+1

                            DO jmem = 1,sphhar%nmem(lh,ns)
                               mv = sphhar%mlh(jmem,lh,ns)
                               coef1 = cil * sphhar%clnu(jmem,lh,ns) 
                               DO mp = -lp,lp
                                  lmp = lp*(lp+1) + mp
                                  DO m = -l,l
                                     lm= l*(l+1) + m
                                     coef=  CONJG( coef1 *gaunt1(l,lv,lp,m,mv,mp,atoms%lmaxd) )

                                     IF (ABS(coef) >= 0 ) THEN
                                        DO nb = 1,ne
                                           cconst= we(nb) * coef
                                           uunmt21(llp,lh,nn) = uunmt21(llp,lh,nn)+ &
                                                cconst * acof(nb,lm,nt,1)*CONJG(acof(nb,lmp,nt,2))
                                           udnmt21(llp,lh,nn) = udnmt21(llp,lh,nn)+&
                                                cconst * bcof(nb,lm,nt,1)*CONJG(acof(nb,lmp,nt,2))
                                           dunmt21(llp,lh,nn) = dunmt21(llp,lh,nn)+&
                                                cconst * acof(nb,lm,nt,1)*CONJG(bcof(nb,lmp,nt,2))
                                           ddnmt21(llp,lh,nn) = ddnmt21(llp,lh,nn)+&
                                                cconst * bcof(nb,lm,nt,1)*CONJG(bcof(nb,lmp,nt,2))
                                        ENDDO ! nb
                                     ENDIF ! (coef >= 0)

                                  ENDDO ! mp
                               ENDDO ! m
                            ENDDO ! jmem

                         ENDIF ! ( MOD(lv+l+lp),2) == 0 )

                      ENDDO ! lp
                   ENDDO ! l
                ENDDO ! lh

             ENDIF ! (atoms%ntypsy(nt)==ns)
          ENDDO ! na
          natom= natom + atoms%neq(nn)
       ENDDO ! nn

    ENDDO ! ns

    RETURN

  END SUBROUTINE rhonmt21
END MODULE m_rhonmt21