u_mix.f90 6.92 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
Daniel Wortmann's avatar
Daniel Wortmann committed
15
  SUBROUTINE u_mix(atoms,jspins,n_mmp_new)
16

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

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

23 24 25 26 27 28
    IMPLICIT NONE
    TYPE(t_atoms),INTENT(IN)   :: atoms
    INTEGER, INTENT (IN)       :: jspins 
    COMPLEX, INTENT (INOUT)    :: n_mmp_new(-3:3,-3:3,atoms%n_u,jspins)
    !
    ! ... Locals ...
Daniel Wortmann's avatar
Daniel Wortmann committed
29 30 31
    INTEGER j,k,iofl,l,itype,ios,i_u,jsp,lty(atoms%n_u)
    REAL alpha,spinf,gam,del,sum1,sum2,mix_u, uParam, jParam
    REAL    theta(atoms%n_u),phi(atoms%n_u),zero(atoms%n_u)
32
    LOGICAL n_exist
Daniel Wortmann's avatar
Daniel Wortmann committed
33
    CHARACTER(LEN=20)   :: attributes(6)
34 35 36 37 38 39 40
    COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:),n_mmp_old(:,:,:,:)
    !
    ! check for possible rotation of n_mmp
    !
    INQUIRE (file='n_mmp_rot',exist=n_exist)
    IF (n_exist) THEN
       OPEN (68,file='n_mmp_rot',status='old',form='formatted')
Daniel Wortmann's avatar
Daniel Wortmann committed
41 42 43 44 45 46 47 48 49 50 51
       DO i_u = 1, atoms%n_u
          l = atoms%lda_u(i_u)%l
          READ(68,*,iostat=ios) theta(i_u),phi(i_u)
          IF (ios == 0) THEN
             lty(i_u) = l
          ELSE
             IF (i_u == 1)  CALL juDFT_error("ERROR reading n_mmp_rot", calledby ="u_mix")
             theta(i_u) = theta(i_u-1) ; phi(i_u) = phi(i_u-1)
             lty(i_u) = lty(i_u-1)
          END IF
       END DO
52 53 54
       CLOSE (68)
       zero = 0.0
       CALL nmat_rot(zero,-theta,-phi,3,atoms%n_u,jspins,lty,n_mmp_new)
Daniel Wortmann's avatar
Daniel Wortmann committed
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
    END IF

    ! Write out n_mmp_new to out.xml file

    CALL openXMLElementNoAttributes('ldaUDensityMatrix')
    DO jsp = 1, jspins
       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       '/),&
                                         attributes,n_mmp_new(-l:l,-l:l,i_u,jsp))
       END DO
    END DO
    CALL closeXMLElement('ldaUDensityMatrix')

80 81 82 83 84 85 86 87
    !
    ! check for LDA+U and open density-matrix - file
    !
    INQUIRE (file='n_mmp_mat',exist=n_exist)
    OPEN (69,file='n_mmp_mat',status='unknown',form='formatted')


    IF (n_exist) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
88 89
       ALLOCATE (n_mmp_old(-3:3,-3:3,atoms%n_u,jspins))
       ALLOCATE (    n_mmp(-3:3,-3:3,atoms%n_u,jspins))
90 91 92 93 94 95 96 97 98 99
       READ (69,9000) n_mmp_old(:,:,:,:)

       READ (69,'(2(6x,f5.3))',IOSTAT=iofl) alpha,spinf
       IF ( iofl == 0 ) THEN
          !
          ! mix here straight with given mixing factors 
          !
          REWIND (69)
          sum1 = 0.0
          IF (jspins.EQ.1) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
100
             DO i_u = 1, atoms%n_u
101 102
                DO j = -3,3
                   DO k = -3,3
Daniel Wortmann's avatar
Daniel Wortmann committed
103 104 105 106 107
                      sum1 = sum1 + ABS(n_mmp_new(k,j,i_u,1) - n_mmp_old(k,j,i_u,1))
                      n_mmp(k,j,i_u,1) = alpha * n_mmp_new(k,j,i_u,1) + (1.0-alpha) * n_mmp_old(k,j,i_u,1)
                   END DO
                END DO
             END DO
108 109 110
             WRITE (6,'(a16,f12.6)') 'n_mmp distance =',sum1
          ELSE
             sum2 = 0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
111 112 113
             gam = 0.5 * alpha * (1.0 + spinf)
             del = 0.5 * alpha * (1.0 - spinf)
             DO i_u = 1,atoms%n_u
114 115
                DO j = -3,3
                   DO k = -3,3
Daniel Wortmann's avatar
Daniel Wortmann committed
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
                      sum1 = sum1 + ABS(n_mmp_new(k,j,i_u,1) - n_mmp_old(k,j,i_u,1))
                      sum2 = sum2 + ABS(n_mmp_new(k,j,i_u,2) - n_mmp_old(k,j,i_u,2))

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

                      n_mmp(k,j,i_u,2) =       gam * n_mmp_new(k,j,i_u,2) + &
                                         (1.0-gam) * n_mmp_old(k,j,i_u,2) + &
                                               del * n_mmp_new(k,j,i_u,1) - &
                                               del * n_mmp_old(k,j,i_u,1)
                   END DO
                END DO
             END DO
131 132 133 134 135 136 137 138 139 140 141 142
             WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 1 =',sum1
             WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 2 =',sum2
          ENDIF
          WRITE (69,9000) n_mmp
          WRITE (69,'(2(a6,f5.3))') 'alpha=',alpha,'spinf=',spinf

       ELSEIF (iofl > 0 ) THEN
          !
          ! read error ; stop
          !
          WRITE (6,*) 'ERROR READING mixing factors in n_mmp_mat'
          WRITE (6,'(2(a6,f5.3))') 'alpha=',alpha,'spinf=',spinf
Daniel Wortmann's avatar
Daniel Wortmann committed
143
          CALL juDFT_error("ERROR READING n_mmp_mat", calledby ="u_mix")
144 145 146 147 148
       ELSE
          !
          ! calculate distance and write new n_mmp to mix in broyden.F
          !
          sum1 = 0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
149
          DO i_u = 1, atoms%n_u
150 151
             DO j = -3,3
                DO k = -3,3
Daniel Wortmann's avatar
Daniel Wortmann committed
152 153 154 155
                   sum1 = sum1 + ABS(n_mmp_new(k,j,i_u,1) - n_mmp_old(k,j,i_u,1))
                END DO
             END DO
          END DO
156 157 158 159 160
          IF (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
Daniel Wortmann's avatar
Daniel Wortmann committed
161
             DO i_u = 1, atoms%n_u
162 163
                DO j = -3,3
                   DO k = -3,3
Daniel Wortmann's avatar
Daniel Wortmann committed
164 165 166 167
                      sum2 = sum2 + ABS(n_mmp_new(k,j,i_u,2) - n_mmp_old(k,j,i_u,2))
                   END DO
                END DO
             END DO
168 169
             DO j=-3,3
                WRITE(6,'(14f12.6)') (n_mmp_old(k,j,1,2),k=-3,3)
Daniel Wortmann's avatar
Daniel Wortmann committed
170
             END DO
171 172 173
             WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 2 =',sum2
             DO j=-3,3
                WRITE(6,'(14f12.6)') (n_mmp_new(k,j,1,2),k=-3,3)
Daniel Wortmann's avatar
Daniel Wortmann committed
174 175
             END DO
          END IF
176 177 178
          REWIND(69)
          WRITE (69,9000) n_mmp_old
          WRITE (69,9000) n_mmp_new
Daniel Wortmann's avatar
Daniel Wortmann committed
179
       END IF !  iofl == 0 
180 181 182 183 184 185 186 187

       DEALLOCATE ( n_mmp_old,n_mmp )
    ELSE
       !
       ! first time with lda+u; write new n_mmp  
       !
       WRITE (69,9000) n_mmp_new
       WRITE (69,'(2(a6,f5.3))') 'alpha=',0.05,'spinf=',1.0
Daniel Wortmann's avatar
Daniel Wortmann committed
188
    END IF
189 190 191 192 193 194

9000 FORMAT(7f20.13)

    CLOSE (69)
  END SUBROUTINE u_mix
END MODULE m_umix