abclocdn.F90 8.4 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
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
  SUBROUTINE abclocdn(atoms, sym, noco,ccchi,kspin,iintsp,con1,phase,ylm,&
24
       ntyp,na,k,s,nv,ne,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof,zMat)
25 26 27 28 29 30
    !
    USE m_types
    IMPLICIT NONE
    TYPE(t_noco),INTENT(IN)   :: noco
    TYPE(t_sym),INTENT(IN)    :: sym
    TYPE(t_atoms),INTENT(IN)  :: atoms
31
    TYPE(t_zMat),INTENT(IN)   :: zMat
32 33 34 35 36 37 38 39
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: kspin,iintsp
    INTEGER, INTENT (IN) :: k,na,ne,ntyp,nv
    REAL,    INTENT (IN) :: con1 ,s
    COMPLEX, INTENT (IN) :: phase
    !     ..
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
40 41 42
    INTEGER, INTENT (IN) :: nbasf0(atoms%nlod,atoms%nat) 
    REAL,    INTENT (IN) :: alo1(atoms%nlod,atoms%ntype),blo1(atoms%nlod,atoms%ntype)
    REAL,    INTENT (IN) :: clo1(atoms%nlod,atoms%ntype)
43 44 45
    COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
    COMPLEX, INTENT (IN) :: ccchi(2)
    INTEGER, INTENT (IN) :: kvec(2*(2*atoms%llod+1),atoms%nlod )
46
    LOGICAL, INTENT (OUT) :: enough ! enough(na)
Daniel Wortmann's avatar
Daniel Wortmann committed
47 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)
    INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%nat)
51 52 53 54 55 56 57 58 59
    !     ..
    !     .. Local Scalars ..
    COMPLEX ctmp,term1
    REAL,PARAMETER:: eps=1.0e-30
    INTEGER i,l,ll1,lm,lo ,mind,nbasf,na2,lmp,m
    !     ..
    !     .. Local Arrays ..
    COMPLEX clotmp(-atoms%llod:atoms%llod)
    !     ..
60
    LOGICAL :: l_real
61
    l_real=zMat%l_real
62
    !     ..
63
    enough = .TRUE.
64 65 66 67 68 69 70 71 72 73 74
    term1 = con1 * ((atoms%rmt(ntyp)**2)/2) * phase
    !---> 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.
    DO lo = 1,atoms%nlo(ntyp)
       l = atoms%llo(lo,ntyp)
       IF (.NOT.((s.LE.eps).AND.(l.GE.1))) THEN
          IF (atoms%invsat(na).EQ.0) THEN

             IF ((nkvec(lo,na)).LT. (2*atoms%llo(lo,ntyp)+1)) THEN
75
                enough = .FALSE.
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
                nkvec(lo,na) = nkvec(lo,na) + 1
                nbasf = nbasf0(lo,na) + nkvec(lo,na)
                l = atoms%llo(lo,ntyp)
                ll1 = l* (l+1)
                DO m = -l,l
                   clotmp(m) = term1*CONJG(ylm(ll1+m+1))
                END DO
                IF ( kvec(nkvec(lo,na),lo) == k ) THEN
                   !                   write(*,'(i3,5(2f10.5,2x))')k,(z(nbasf,i),i=11,15)
                   DO i = 1,ne
                      DO m = -l,l
                         lm = ll1 + m
                         !+gu_con
                         IF (noco%l_noco) THEN
                            IF (noco%l_ss) THEN
91
                               ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,i)
92
                            ELSE
93
                               ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,i)+ccchi(2)*zMat%z_c(kspin+nbasf,i) )
94 95
                            ENDIF
                         ELSE
96
                            IF (l_real) THEN
97
                               ctmp = zMat%z_r(nbasf,i)*clotmp(m)
98
                            ELSE
99
                               ctmp = zMat%z_c(nbasf,i)*clotmp(m)
100
                            ENDIF
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
                         ENDIF
                         acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
                         bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo,ntyp)
                         ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo,ntyp)
                      END DO
                   END DO
                   !                  write(6,9000) nbasf,k,lo,na,
                   !     +                          (clo1(lo,ntyp)*clotmp(m),m=-l,l)
                   ! 9000             format(2i4,2i2,7(' (',e9.3,',',e9.3,')'))
                ELSE
                   nkvec(lo,na) = nkvec(lo,na) - 1
                ENDIF ! kvec = k
             ENDIF   ! nkvec < 2*atoms%llo

          ELSEIF (atoms%invsat(na).EQ.1) THEN
             IF ((nkvec(lo,na)).LT. (2* (2*atoms%llo(lo,ntyp)+1))) THEN
117
                enough = .FALSE.
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
                nkvec(lo,na) = nkvec(lo,na) + 1
                nbasf = nbasf0(lo,na) + nkvec(lo,na)
                l = atoms%llo(lo,ntyp)
                ll1 = l* (l+1)
                DO m = -l,l
                   clotmp(m) = term1*CONJG(ylm(ll1+m+1))
                END DO
                IF ( kvec(nkvec(lo,na),lo) == k ) THEN
                   !                  write(*,*)'k vector nr ',k,' has been accepted'
                   !                  write(*,'(i3,5(2f10.5,2x))')k,(z(nbasf,i),i=11,15)
                   DO i = 1,ne
                      DO m = -l,l
                         lm = ll1 + m
                         !                        if(i.eq.1 .and. l.eq.1) then
                         !              write(*,*)'k=',k,' z=',z(nbasf,i),' clotmp=',clotmp(m)
                         !              write(*,*)'clo1=',clo1(lo,ntyp),' term1=',term1
                         !                         endif
                         !+gu_con
                         IF (noco%l_noco) THEN
                            IF (noco%l_ss) THEN
138
                               ctmp = clotmp(m)*ccchi(iintsp)*zMat%z_c(kspin+nbasf,i)
139
                            ELSE
140
                               ctmp = clotmp(m)*( ccchi(1)*zMat%z_c(nbasf,i)+ ccchi(2)*zMat%z_c(kspin+nbasf,i) )
141 142
                            ENDIF
                         ELSE
143
                            IF (l_real) THEN
144
                               ctmp = zMat%z_r(nbasf,i)*clotmp(m)
145
                            ELSE
146
                               ctmp = zMat%z_c(nbasf,i)*clotmp(m)
147
                            ENDIF
148 149 150 151
                         ENDIF
                         acof(i,lm,na) = acof(i,lm,na) +ctmp*alo1(lo,ntyp)
                         bcof(i,lm,na) = bcof(i,lm,na) +ctmp*blo1(lo,ntyp)
                         ccof(m,i,lo,na) = ccof(m,i,lo,na) +ctmp*clo1(lo,ntyp)
152
                         IF (noco%l_soc.AND.sym%invs) THEN
153
                            ctmp = zMat%z_c(nbasf,i)*CONJG(clotmp(m))*(-1)**(l-m)
154 155 156 157 158 159
                            na2 = sym%invsatnr(na)
                            lmp = ll1 - m
                            acof(i,lmp,na2) = acof(i,lmp,na2) +ctmp*alo1(lo,ntyp)
                            bcof(i,lmp,na2) = bcof(i,lmp,na2) +ctmp*blo1(lo,ntyp)
                            ccof(-m,i,lo,na2) = ccof(-m,i,lo,na2) +ctmp*clo1(lo,ntyp)
                         ENDIF
160 161 162 163 164 165 166 167 168 169
                      ENDDO  ! m
                   ENDDO     ! i = 1,ne
                ELSE       
                   nkvec(lo,na) = nkvec(lo,na) - 1
                ENDIF       ! kvec = k
             ENDIF         ! nkvec < 2*atoms%llo
          ELSE
             CALL juDFT_error("invsat =/= 0 or 1",calledby ="abclocdn")
          ENDIF
       ELSE
170
          enough = .FALSE.
171 172
       ENDIF  ! s > eps  & l >= 1
    END DO
173
    IF ((k.EQ.nv) .AND. (.NOT.enough)) THEN
174 175 176
       WRITE (6,FMT=*) 'abclocdn did not find enough linearly independent'
       WRITE (6,FMT=*) 'ccof coefficient-vectors.'
       CALL juDFT_error("did not find enough lin. ind. ccof-vectors" ,calledby ="abclocdn")
177 178 179 180
    END IF

  END SUBROUTINE abclocdn
END MODULE m_abclocdn