LCOV - code coverage report
Current view: top level - mix - u_mix.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 40 60 66.7 %
Date: 2024-03-28 04:22:06 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_umix
       8             :    !
       9             :    ! mix the old and new density matrix for the lda+U method
      10             :    !                                                 gb.2001
      11             :    ! --------------------------------------------------------
      12             :    ! Extension to multiple U per atom type by G.M. 2017
      13             :    USE m_juDFT
      14             :    USE m_types
      15             :    USE m_constants
      16             :    USE m_xmlOutput
      17             : 
      18             :    IMPLICIT NONE
      19             : 
      20             :    CONTAINS
      21             : 
      22          31 :    SUBROUTINE u_mix(input,atoms,noco,n_mmp_in,n_mmp_out)
      23             : 
      24             :       TYPE(t_input),INTENT(IN)    :: input
      25             :       TYPE(t_atoms),INTENT(IN)    :: atoms
      26             :       TYPE(t_noco), INTENT(IN)    :: noco
      27             :       COMPLEX,      INTENT(IN)    :: n_mmp_out(-lmaxU_const:,-lmaxU_const:,:,:)
      28             :       COMPLEX,      INTENT(INOUT) :: n_mmp_in (-lmaxU_const:,-lmaxU_const:,:,:)
      29             : 
      30             : 
      31             :       INTEGER :: mp,m,l,itype,i_u,jsp
      32             :       REAL    :: alpha,spinf,gam,del,uParam,jParam
      33          31 :       REAL    :: zero(atoms%n_u),dist(SIZE(n_mmp_in,4))
      34             : 
      35             :       CHARACTER(LEN=20)   :: attributes(6)
      36          31 :       COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:)
      37             : 
      38             :       !
      39             :       ! check for possible rotation of n_mmp
      40             :       !
      41             :       !zero=0.0
      42             :       !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)
      43             : 
      44             :       ! Write out n_mmp_out to out.xml file
      45          31 :       CALL openXMLElementNoAttributes('ldaUDensityMatrix')
      46          80 :       DO jsp = 1, SIZE(n_mmp_out,4)
      47         192 :          DO i_u = 1, atoms%n_u
      48         112 :             l = atoms%lda_u(i_u)%l
      49         112 :             itype = atoms%lda_u(i_u)%atomType
      50         112 :             uParam = atoms%lda_u(i_u)%u
      51         112 :             jParam = atoms%lda_u(i_u)%j
      52         784 :             attributes = ''
      53         112 :             WRITE(attributes(1),'(i0)') jsp
      54         112 :             WRITE(attributes(2),'(i0)') itype
      55         112 :             WRITE(attributes(3),'(i0)') i_u
      56         112 :             WRITE(attributes(4),'(i0)') l
      57         112 :             WRITE(attributes(5),'(f15.8)') uParam
      58         112 :             WRITE(attributes(6),'(f15.8)') jParam
      59             :             CALL writeXMLElementMatrixPoly('densityMatrixFor',&
      60             :                                           (/'spin    ','atomType','uIndex  ','l       ','U       ','J       '/),&
      61         833 :                                           attributes,n_mmp_out(-l:l,-l:l,i_u,jsp))
      62             :          END DO
      63             :       END DO
      64          31 :       CALL closeXMLElement('ldaUDensityMatrix')
      65             : 
      66             :       ! exit subroutine if density matrix does not exist
      67         805 :       IF(.NOT.ANY(ABS(n_mmp_in(:,:,1:atoms%n_u,:)).GT.1e-12)) RETURN
      68             : 
      69             :       !Calculate distance
      70          75 :       dist = 0.0
      71         105 :       DO i_u = 1, atoms%n_u
      72         637 :          DO m = -lmaxU_const,lmaxU_const
      73        4332 :             DO mp = -lmaxU_const,lmaxU_const
      74        9352 :                DO jsp = 1, SIZE(n_mmp_in,4)
      75        8820 :                   dist(jsp) = dist(jsp) + ABS(n_mmp_out(m,mp,i_u,jsp) - n_mmp_in(m,mp,i_u,jsp))
      76             :                ENDDO
      77             :             ENDDO
      78             :          ENDDO
      79             :       ENDDO
      80             :       !Write to outfile
      81          29 :       IF(input%jspins.EQ.1) THEN
      82          12 :          WRITE (oUnit,'(a,f12.6)') 'n_mmp distance =',dist(1)
      83             :       ELSE
      84          51 :          DO jsp = 1, SIZE(n_mmp_in,4)
      85         134 :             if (jsp > 2 .and. .not.any(noco%l_spinoffd_ldau)) cycle
      86          51 :             WRITE (oUnit,9000) 'n_mmp distance spin ',jsp,' =',dist(jsp)
      87             : 9000        FORMAT(a,I1,a,f12.6)
      88             :          ENDDO
      89             :       ENDIF
      90             : 
      91          29 :       IF (input%ldauLinMix) THEN
      92             : 
      93             :          ! mix here straight with given mixing factors
      94           0 :          ALLOCATE (n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,SIZE(n_mmp_in,dim=3),SIZE(n_mmp_in,dim=4)))
      95           0 :          n_mmp = cmplx_0
      96             : 
      97           0 :          alpha = input%ldauMixParam
      98           0 :          spinf = input%ldauSpinf
      99             : 
     100           0 :          IF (input%jspins.EQ.1) THEN
     101           0 :             DO i_u = 1, atoms%n_u
     102           0 :                DO m = -lmaxU_const,lmaxU_const
     103           0 :                   DO mp = -lmaxU_const,lmaxU_const
     104             : 
     105             :                      n_mmp(m,mp,i_u,1) =      alpha * n_mmp_out(m,mp,i_u,1) + &
     106           0 :                                         (1.0-alpha) * n_mmp_in (m,mp,i_u,1)
     107             : 
     108             :                   END DO
     109             :                END DO
     110             :             END DO
     111             :          ELSE
     112           0 :             gam = 0.5 * alpha * (1.0 + spinf)
     113           0 :             del = 0.5 * alpha * (1.0 - spinf)
     114           0 :             DO i_u = 1,atoms%n_u
     115           0 :                DO m = -lmaxU_const,lmaxU_const
     116           0 :                   DO mp = -lmaxU_const,lmaxU_const
     117             : 
     118             :                      n_mmp(m,mp,i_u,1) =       gam * n_mmp_out(m,mp,i_u,1) + &
     119             :                                          (1.0-gam) * n_mmp_in (m,mp,i_u,1) - &
     120             :                                                del * n_mmp_out(m,mp,i_u,2) + &
     121           0 :                                                del * n_mmp_in (m,mp,i_u,2)
     122             : 
     123             :                      n_mmp(m,mp,i_u,2) =       gam * n_mmp_out(m,mp,i_u,2) + &
     124             :                                          (1.0-gam) * n_mmp_in (m,mp,i_u,2) - &
     125             :                                                del * n_mmp_out(m,mp,i_u,1) + &
     126           0 :                                                del * n_mmp_in (m,mp,i_u,1)
     127           0 :                      IF(noco%l_mperp) THEN
     128             :                         n_mmp(m,mp,i_u,3) =       alpha * n_mmp_out(m,mp,i_u,3) + &
     129           0 :                                             (1.0-alpha) * n_mmp_in (m,mp,i_u,3)
     130             :                      ENDIF
     131             : 
     132             :                   END DO
     133             :                END DO
     134             :             END DO
     135             : 
     136             :          ENDIF
     137           0 :          n_mmp_in = n_mmp
     138           0 :          DEALLOCATE(n_mmp)
     139             :       ENDIF
     140             : 
     141          29 :       CALL openXMLElementNoAttributes('ldaUDensityMatrixConvergence')
     142          75 :       DO jsp = 1, SIZE(dist)
     143         170 :          if (jsp > 2 .and. .not.any(noco%l_spinoffd_ldau)) cycle
     144         322 :          attributes = ''
     145          46 :          WRITE(attributes(1),'(i0)') jsp
     146          46 :          WRITE(attributes(2),'(f13.6)') dist(jsp)
     147         167 :          CALL writeXMLElementForm('distance',['spin    ','distance'],attributes(:2),reshape([4,8,1,13],[2,2]))
     148             :       ENDDO
     149          29 :       CALL closeXMLElement('ldaUDensityMatrixConvergence')
     150             : 
     151             :    END SUBROUTINE u_mix
     152             : END MODULE m_umix

Generated by: LCOV version 1.14