abclocdn.F90 8.14 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 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
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,&
       ntyp,na,k,s,nv,ne,z,nbasf0,alo1,blo1,clo1,kvec,nkvec,enough,acof,bcof,ccof)
    !
    USE m_types
    IMPLICIT NONE
    TYPE(t_noco),INTENT(IN)   :: noco
    TYPE(t_sym),INTENT(IN)    :: sym
    TYPE(t_atoms),INTENT(IN)  :: atoms
    !     ..
    !     .. 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 ..
    INTEGER, INTENT (IN) :: nbasf0(atoms%nlod,atoms%natd) 
    REAL,    INTENT (IN) :: alo1(atoms%nlod,atoms%ntypd),blo1(atoms%nlod,atoms%ntypd)
    REAL,    INTENT (IN) :: clo1(atoms%nlod,atoms%ntypd)
    COMPLEX, INTENT (IN) :: ylm( (atoms%lmaxd+1)**2 )
    COMPLEX, INTENT (IN) :: ccchi(2)
    INTEGER, INTENT (IN) :: kvec(2*(2*atoms%llod+1),atoms%nlod )
    LOGICAL, INTENT (OUT) :: enough(atoms%natd)
    COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%natd)
    COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%natd)
    COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%natd)
    INTEGER, INTENT (INOUT) :: nkvec(atoms%nlod,atoms%natd)
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
    COMPLEX, INTENT (IN) :: z(:,:)!(dimension%nbasfcn,dimension%neigd)
#else
    REAL,    INTENT (IN) :: z(:,:)!(dimension%nbasfcn,dimension%neigd)
#endif
    !     ..
    !     .. 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)
    !     ..

    !     ..
    enough(na) = .TRUE.
    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
                enough(na) = .FALSE.
                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
                               ctmp = clotmp(m)*ccchi(iintsp)*z(kspin+nbasf,i)
                            ELSE
                               ctmp = clotmp(m)*( ccchi(1)*z(nbasf,i)+ccchi(2)*z(kspin+nbasf,i) )
                            ENDIF
                         ELSE
                            ctmp = z(nbasf,i)*clotmp(m)
                         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
                enough(na) = .FALSE.
                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
                               ctmp = clotmp(m)*ccchi(iintsp)*z(kspin+nbasf,i)
                            ELSE
                               ctmp = clotmp(m)*( ccchi(1)*z(nbasf,i)+ ccchi(2)*z(kspin+nbasf,i) )
                            ENDIF
                         ELSE
                            ctmp = z(nbasf,i)*clotmp(m)
                         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)
#if ( defined(CPP_SOC) && defined(CPP_INVERSION) )
                         ctmp = z(nbasf,i)*CONJG(clotmp(m))*(-1)**(l-m)
                         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
                      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
          enough(na) = .FALSE.
       ENDIF  ! s > eps  & l >= 1
    END DO
    IF ((k.EQ.nv) .AND. (.NOT.enough(na))) THEN
       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")
    END IF

  END SUBROUTINE abclocdn
END MODULE m_abclocdn