brysh2.f90 4.22 KB
Newer Older
1 2 3 4 5 6 7
MODULE m_brysh2
  USE m_juDFT
  !******************************************************
  !     maps the density back from one single vector into the
  !     proper component of interstitial, m.t. and vacuum density
  !******************************************************
CONTAINS 
8 9
  SUBROUTINE brysh2(input,stars,atoms,sphhar,noco,vacuum,&
                    sym,s_in,oneD,den)
10 11 12
    USE m_types
    IMPLICIT NONE

13 14 15 16 17 18 19 20 21 22
    TYPE(t_oneD),INTENT(IN)      :: oneD
    TYPE(t_input),INTENT(IN)     :: input
    TYPE(t_vacuum),INTENT(IN)    :: vacuum
    TYPE(t_noco),INTENT(IN)      :: noco
    TYPE(t_sym),INTENT(IN)       :: sym
    TYPE(t_stars),INTENT(IN)     :: stars
    TYPE(t_sphhar),INTENT(IN)    :: sphhar
    TYPE(t_atoms),INTENT(IN)     :: atoms
    TYPE(t_potden),INTENT(INOUT) :: den

23
    REAL,    INTENT (IN) :: s_in(:)
24 25

    ! Local Scalars
26
    INTEGER i,iv,j,js,k,l,n,na
27

Gregor Michalicek's avatar
Gregor Michalicek committed
28 29 30 31 32
    den%pw = CMPLX(0.0,0.0)
    den%mt = 0.0
    den%vacz = 0.0
    den%vacxy = CMPLX(0.0,0.0)

33 34 35 36 37
    j=0
    DO  js = 1,input%jspins
       IF (sym%invs) THEN
          DO i = 1,stars%ng3
             j = j + 1
38
             den%pw(i,js) = CMPLX(s_in(j),0.0)
39 40 41 42
          END DO
       ELSE
          DO i = 1,stars%ng3
             j = j + 1
43
             den%pw(i,js) = CMPLX(s_in(j),s_in(j+stars%ng3))
44 45 46 47 48 49 50 51
          END DO
          j = j + stars%ng3
       ENDIF
       na = 1
       DO n = 1,atoms%ntype
          DO l = 0,sphhar%nlh(atoms%ntypsy(na))
             DO i = 1,atoms%jri(n)
                j = j + 1
52
                den%mt(i,l,n,js) = s_in(j)
53 54 55 56 57 58 59 60
             END DO
          END DO
          na = na + atoms%neq(n)
       END DO
       IF (input%film) THEN
          DO iv = 1,vacuum%nvac
             DO k = 1,vacuum%nmz
                j = j + 1
61
                den%vacz(k,iv,js) = s_in(j)
62
             END DO
63
             DO k = 1,stars%ng2-1
64 65
                DO i = 1,vacuum%nmzxy
                   j = j + 1
66
                   den%vacxy(i,k,iv,js) = CMPLX(s_in(j),0.0)
67 68 69
                END DO
             END DO
             IF (.NOT.sym%invs2) THEN
70
                DO k = 1,stars%ng2-1
71 72
                   DO i = 1,vacuum%nmzxy
                      j = j + 1
73
                      den%vacxy(i,k,iv,js) = den%vacxy(i,k,iv,js) + CMPLX(0.0,s_in(j))
74 75 76 77 78 79 80 81 82 83 84
                   END DO
                END DO
             END IF
          END DO
       END IF
    enddo

    IF (noco%l_noco) THEN
       !--->    off-diagonal part of the density matrix
       DO i = 1,stars%ng3
          j = j + 1
Gregor Michalicek's avatar
Gregor Michalicek committed
85
          den%pw(i,3) = CMPLX(s_in(j),0.0)
86 87 88
       END DO
       DO i = 1,stars%ng3
          j = j + 1
Gregor Michalicek's avatar
Gregor Michalicek committed
89
          den%pw(i,3) = den%pw(i,3) + CMPLX(0.0,s_in(j))
90 91 92 93 94
       END DO
       IF (input%film) THEN
          DO iv = 1,vacuum%nvac
             DO k = 1,vacuum%nmz
                j = j + 1
Gregor Michalicek's avatar
Gregor Michalicek committed
95
                den%vacz(k,iv,3) = s_in(j)
96
             END DO
97
             DO k = 1,stars%ng2-1
98 99
                DO i = 1,vacuum%nmzxy
                   j = j + 1
Gregor Michalicek's avatar
Gregor Michalicek committed
100
                   den%vacxy(i,k,iv,3) = CMPLX(s_in(j),0.0)
101 102 103 104 105 106
                END DO
             END DO
          END DO
          DO iv = 1,vacuum%nvac
             DO k = 1,vacuum%nmz
                j = j + 1
Gregor Michalicek's avatar
Gregor Michalicek committed
107
                den%vacz(k,iv,4) = s_in(j)
108
             END DO
109
             DO k = 1,stars%ng2-1
110 111
                DO i = 1,vacuum%nmzxy
                   j = j + 1
Gregor Michalicek's avatar
Gregor Michalicek committed
112
                   den%vacxy(i,k,iv,3) = den%vacxy(i,k,iv,3)+ CMPLX(0.0,s_in(j))
113 114 115 116
                END DO
             END DO
          END DO
       END IF
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
       !MT part
       IF (noco%l_mtnocopot) THEN
          na = 1
          DO n = 1,atoms%ntype
             DO l = 0,sphhar%nlh(atoms%ntypsy(na))
                DO i = 1,atoms%jri(n)
                   j = j + 1
                   den%mt(i,l,n,3)=s_in(j) 
                   j = j + 1
                    den%mt(i,l,n,4)=s_in(j)
                END DO
             END DO
             na = na + atoms%neq(n)
          END DO
       END IF
132 133 134 135 136 137 138 139
    ENDIF

    IF ( atoms%n_u > 0 ) THEN
       DO js = 1,input%jspins
          DO n = 1, atoms%n_u
             DO k = -3, 3
                DO i = -3, 3
                   j = j + 1
140
                   den%mmpMat(i,k,n,js) = CMPLX(s_in(j),s_in(j+1))
141 142 143 144 145 146 147 148 149
                   j = j + 1
                ENDDO
             ENDDO
          ENDDO
       ENDDO
    ENDIF

  END SUBROUTINE brysh2
   END MODULE m_brysh2