u_mix.f90 6.98 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(atoms,jspins,n_mmp_in,n_mmp_out)
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
    IMPLICIT NONE
    TYPE(t_atoms),INTENT(IN)   :: atoms
    INTEGER, INTENT (IN)       :: jspins 
26 27
    COMPLEX, INTENT (INOUT)    :: n_mmp_out(-3:3,-3:3,atoms%n_u,jspins)
    COMPLEX, INTENT (INOUT)    :: n_mmp_in (-3:3,-3:3,atoms%n_u,jspins)
28 29
    !
    ! ... Locals ...
Daniel Wortmann's avatar
Daniel Wortmann committed
30 31 32
    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)
33
    LOGICAL n_exist
Daniel Wortmann's avatar
Daniel Wortmann committed
34
    CHARACTER(LEN=20)   :: attributes(6)
35
    COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:)
36 37 38 39 40 41
    !
    ! 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
42 43 44 45 46 47 48 49 50 51 52
       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
53 54
       CLOSE (68)
       zero = 0.0
55
       CALL nmat_rot(zero,-theta,-phi,3,atoms%n_u,jspins,lty,n_mmp_out)
Daniel Wortmann's avatar
Daniel Wortmann committed
56 57
    END IF

58
    ! Write out n_mmp_out to out.xml file
Daniel Wortmann's avatar
Daniel Wortmann committed
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75

    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       '/),&
76
                                         attributes,n_mmp_out(-l:l,-l:l,i_u,jsp))
Daniel Wortmann's avatar
Daniel Wortmann committed
77 78 79 80
       END DO
    END DO
    CALL closeXMLElement('ldaUDensityMatrix')

81 82 83 84 85 86 87 88
    !
    ! 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
89 90 91
       ALLOCATE (   n_mmp(-3:3,-3:3,atoms%n_u,jspins))
       READ (69,9000) n_mmp(:,:,:,:)
       n_mmp = CMPLX(0.0,0.0)
92 93 94 95 96 97 98 99 100

       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
101
             DO i_u = 1, atoms%n_u
102 103
                DO j = -3,3
                   DO k = -3,3
104 105
                      sum1 = sum1 + ABS(n_mmp_out(k,j,i_u,1) - n_mmp_in(k,j,i_u,1))
                      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
106 107 108
                   END DO
                END DO
             END DO
109 110 111
             WRITE (6,'(a16,f12.6)') 'n_mmp distance =',sum1
          ELSE
             sum2 = 0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
112 113 114
             gam = 0.5 * alpha * (1.0 + spinf)
             del = 0.5 * alpha * (1.0 - spinf)
             DO i_u = 1,atoms%n_u
115 116
                DO j = -3,3
                   DO k = -3,3
117 118 119 120 121 122 123 124 125 126 127 128
                      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
129 130 131
                   END DO
                END DO
             END DO
132 133 134 135 136
             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
137
          n_mmp_in = n_mmp
138 139 140 141 142 143 144

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

183
       DEALLOCATE (n_mmp)
184 185 186 187
    ELSE
       !
       ! first time with lda+u; write new n_mmp  
       !
188
       WRITE (69,9000) n_mmp_out
189
       WRITE (69,'(2(a6,f5.3))') 'alpha=',0.05,'spinf=',1.0
190
       n_mmp_in = n_mmp_out
Daniel Wortmann's avatar
Daniel Wortmann committed
191
    END IF
192 193 194 195 196 197

9000 FORMAT(7f20.13)

    CLOSE (69)
  END SUBROUTINE u_mix
END MODULE m_umix