u_mix.f90 5.38 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
MODULE m_umix
  USE m_juDFT
  !
  ! mix the old and new density matrix for the lda+U method
  !                                                 gb.2001
Daniel Wortmann's avatar
Daniel Wortmann committed
12 13
  ! --------------------------------------------------------
  ! Extension to multiple U per atom type by G.M. 2017
14
CONTAINS
15
  SUBROUTINE u_mix(input,atoms,n_mmp_in,n_mmp_out)
16

Daniel Wortmann's avatar
Daniel Wortmann committed
17
    USE m_types
18
    USE m_cdn_io
19
    USE m_nmat_rot
Daniel Wortmann's avatar
Daniel Wortmann committed
20 21
    USE m_xmlOutput

22
    ! ... Arguments
Daniel Wortmann's avatar
Daniel Wortmann committed
23

24
    IMPLICIT NONE
25
    TYPE(t_input),INTENT(IN)   :: input
26
    TYPE(t_atoms),INTENT(IN)   :: atoms
27 28
    COMPLEX, INTENT (INOUT)    :: n_mmp_out(-3:3,-3:3,atoms%n_u,input%jspins)
    COMPLEX, INTENT (INOUT)    :: n_mmp_in (-3:3,-3:3,atoms%n_u,input%jspins)
29 30
    !
    ! ... Locals ...
31
    INTEGER j,k,iofl,l,itype,ios,i_u,jsp
Daniel Wortmann's avatar
Daniel Wortmann committed
32
    REAL alpha,spinf,gam,del,sum1,sum2,mix_u, uParam, jParam
33
    REAL    zero(atoms%n_u)
Daniel Wortmann's avatar
Daniel Wortmann committed
34
    CHARACTER(LEN=20)   :: attributes(6)
35
    COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:)
36 37 38
    !
    ! check for possible rotation of n_mmp
    !
39 40
    zero=0.0
    CALL nmat_rot(zero,-atoms%lda_u%theta,-atoms%lda_u%phi,3,atoms%n_u,input%jspins,atoms%lda_u%l,n_mmp_out)
Daniel Wortmann's avatar
Daniel Wortmann committed
41

42
    ! Write out n_mmp_out to out.xml file
Daniel Wortmann's avatar
Daniel Wortmann committed
43 44

    CALL openXMLElementNoAttributes('ldaUDensityMatrix')
45
    DO jsp = 1, input%jspins
Daniel Wortmann's avatar
Daniel Wortmann committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59
       DO i_u = 1, atoms%n_u
          l = atoms%lda_u(i_u)%l
          itype = atoms%lda_u(i_u)%atomType
          uParam = atoms%lda_u(i_u)%u
          jParam = atoms%lda_u(i_u)%j
          attributes = ''
          WRITE(attributes(1),'(i0)') jsp
          WRITE(attributes(2),'(i0)') itype
          WRITE(attributes(3),'(i0)') i_u
          WRITE(attributes(4),'(i0)') l
          WRITE(attributes(5),'(f15.8)') uParam
          WRITE(attributes(6),'(f15.8)') jParam
          CALL writeXMLElementMatrixPoly('densityMatrixFor',&
                                         (/'spin    ','atomType','uIndex  ','l       ','U       ','J       '/),&
60
                                         attributes,n_mmp_out(-l:l,-l:l,i_u,jsp))
Daniel Wortmann's avatar
Daniel Wortmann committed
61 62 63 64
       END DO
    END DO
    CALL closeXMLElement('ldaUDensityMatrix')

65 66
    ! exit subroutine if density matrix does not exist
    IF(.NOT.ANY(n_mmp_in(:,:,:,:).NE.0.0)) THEN
67 68
       RETURN
    END IF
69

70
    IF (input%ldauLinMix) THEN
71

72
       ! mix here straight with given mixing factors
73

74 75
       ALLOCATE (n_mmp(-3:3,-3:3,MAX(1,atoms%n_u),input%jspins))
       n_mmp = CMPLX(0.0,0.0)
76

77 78
       alpha = input%ldauMixParam
       spinf = input%ldauSpinf
79

80 81
       sum1 = 0.0
       IF (input%jspins.EQ.1) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
82
          DO i_u = 1, atoms%n_u
83 84
             DO j = -3,3
                DO k = -3,3
85
                   sum1 = sum1 + ABS(n_mmp_out(k,j,i_u,1) - n_mmp_in(k,j,i_u,1))
86
                   n_mmp(k,j,i_u,1) = alpha * n_mmp_out(k,j,i_u,1) + (1.0-alpha) * n_mmp_in(k,j,i_u,1)
Daniel Wortmann's avatar
Daniel Wortmann committed
87 88 89
                END DO
             END DO
          END DO
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
          WRITE (6,'(a16,f12.6)') 'n_mmp distance =',sum1
       ELSE
          sum2 = 0.0
          gam = 0.5 * alpha * (1.0 + spinf)
          del = 0.5 * alpha * (1.0 - spinf)
          DO i_u = 1,atoms%n_u
             DO j = -3,3
                DO k = -3,3
                   sum1 = sum1 + ABS(n_mmp_out(k,j,i_u,1) - n_mmp_in(k,j,i_u,1))
                   sum2 = sum2 + ABS(n_mmp_out(k,j,i_u,2) - n_mmp_in(k,j,i_u,2))

                   n_mmp(k,j,i_u,1) =       gam * n_mmp_out(k,j,i_u,1) + &
                                      (1.0-gam) * n_mmp_in (k,j,i_u,1) + &
                                            del * n_mmp_out(k,j,i_u,2) - &
                                            del * n_mmp_in (k,j,i_u,2)

                   n_mmp(k,j,i_u,2) =       gam * n_mmp_out(k,j,i_u,2) + &
                                      (1.0-gam) * n_mmp_in (k,j,i_u,2) + &
                                            del * n_mmp_out(k,j,i_u,1) - &
                                            del * n_mmp_in (k,j,i_u,1)
Daniel Wortmann's avatar
Daniel Wortmann committed
110 111
                END DO
             END DO
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
          END DO
          WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 1 =',sum1
          WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 2 =',sum2
       ENDIF
       n_mmp_in = n_mmp
       DEALLOCATE (n_mmp)
    ELSE ! input%ldauLinMix

       ! only calculate distance

       sum1 = 0.0
       DO i_u = 1, atoms%n_u
          DO j = -3,3
             DO k = -3,3
                sum1 = sum1 + ABS(n_mmp_out(k,j,i_u,1) - n_mmp_in(k,j,i_u,1))
Daniel Wortmann's avatar
Daniel Wortmann committed
127
             END DO
128 129 130 131 132 133 134 135 136 137 138 139
          END DO
       END DO
       IF (input%jspins.EQ.1) THEN
          WRITE (6,'(a16,f12.6)') 'n_mmp distance =',sum1
       ELSE
          sum2 = 0.0
          WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 1 =',sum1
          DO i_u = 1, atoms%n_u
             DO j = -3,3
                DO k = -3,3
                   sum2 = sum2 + ABS(n_mmp_out(k,j,i_u,2) - n_mmp_in(k,j,i_u,2))
                END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
140
             END DO
141 142 143 144 145 146 147 148 149 150
          END DO
          DO j=-3,3
             WRITE(6,'(14f12.6)') (n_mmp_in(k,j,1,2),k=-3,3)
          END DO
          WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 2 =',sum2
          DO j=-3,3
             WRITE(6,'(14f12.6)') (n_mmp_out(k,j,1,2),k=-3,3)
          END DO
       END IF
    END IF ! input%ldauLinMix
151 152 153

  END SUBROUTINE u_mix
END MODULE m_umix