LCOV - code coverage report
Current view: top level - mix - u_mix.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 30 67 44.8 %
Date: 2019-09-08 04:53:50 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             :   USE m_juDFT
       9             :   !
      10             :   ! mix the old and new density matrix for the lda+U method
      11             :   !                                                 gb.2001
      12             :   ! --------------------------------------------------------
      13             :   ! Extension to multiple U per atom type by G.M. 2017
      14             : CONTAINS
      15          14 :   SUBROUTINE u_mix(input,atoms,n_mmp_in,n_mmp_out)
      16             : 
      17             :     USE m_types
      18             :     USE m_cdn_io
      19             :     USE m_nmat_rot
      20             :     USE m_xmlOutput
      21             : 
      22             :     ! ... Arguments
      23             : 
      24             :     IMPLICIT NONE
      25             :     TYPE(t_input),INTENT(IN)   :: input
      26             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      27             :     COMPLEX, INTENT (INOUT)    :: n_mmp_out(-3:3,-3:3,atoms%n_u,input%jspins)
      28             :     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
      32             :     REAL alpha,spinf,gam,del,sum1,sum2,mix_u, uParam, jParam
      33          27 :     REAL    zero(atoms%n_u)
      34             :     CHARACTER(LEN=20)   :: attributes(6)
      35          14 :     COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:)
      36             :     !
      37             :     ! check for possible rotation of n_mmp
      38             :     !
      39          70 :     zero=0.0
      40          14 :     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)
      41             : 
      42             :     ! Write out n_mmp_out to out.xml file
      43             : 
      44          14 :     CALL openXMLElementNoAttributes('ldaUDensityMatrix')
      45          28 :     DO jsp = 1, input%jspins
      46          84 :        DO i_u = 1, atoms%n_u
      47          56 :           l = atoms%lda_u(i_u)%l
      48          56 :           itype = atoms%lda_u(i_u)%atomType
      49          56 :           uParam = atoms%lda_u(i_u)%u
      50          56 :           jParam = atoms%lda_u(i_u)%j
      51         392 :           attributes = ''
      52          56 :           WRITE(attributes(1),'(i0)') jsp
      53          56 :           WRITE(attributes(2),'(i0)') itype
      54          56 :           WRITE(attributes(3),'(i0)') i_u
      55          56 :           WRITE(attributes(4),'(i0)') l
      56          56 :           WRITE(attributes(5),'(f15.8)') uParam
      57          56 :           WRITE(attributes(6),'(f15.8)') jParam
      58             :           CALL writeXMLElementMatrixPoly('densityMatrixFor',&
      59             :                                          (/'spin    ','atomType','uIndex  ','l       ','U       ','J       '/),&
      60          70 :                                          attributes,n_mmp_out(-l:l,-l:l,i_u,jsp))
      61             :        END DO
      62             :     END DO
      63          14 :     CALL closeXMLElement('ldaUDensityMatrix')
      64             : 
      65             :     ! exit subroutine if density matrix does not exist
      66          15 :     IF(.NOT.ANY(n_mmp_in(:,:,:,:).NE.0.0)) THEN
      67             :        RETURN
      68             :     END IF
      69             : 
      70          13 :     IF (input%ldauLinMix) THEN
      71             : 
      72             :        ! mix here straight with given mixing factors
      73             : 
      74           0 :        ALLOCATE (n_mmp(-3:3,-3:3,MAX(1,atoms%n_u),input%jspins))
      75           0 :        n_mmp = CMPLX(0.0,0.0)
      76             : 
      77           0 :        alpha = input%ldauMixParam
      78           0 :        spinf = input%ldauSpinf
      79             : 
      80           0 :        sum1 = 0.0
      81           0 :        IF (input%jspins.EQ.1) THEN
      82           0 :           DO i_u = 1, atoms%n_u
      83           0 :              DO j = -3,3
      84           0 :                 DO k = -3,3
      85           0 :                    sum1 = sum1 + ABS(n_mmp_out(k,j,i_u,1) - n_mmp_in(k,j,i_u,1))
      86           0 :                    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)
      87             :                 END DO
      88             :              END DO
      89             :           END DO
      90           0 :           WRITE (6,'(a16,f12.6)') 'n_mmp distance =',sum1
      91             :        ELSE
      92           0 :           sum2 = 0.0
      93           0 :           gam = 0.5 * alpha * (1.0 + spinf)
      94           0 :           del = 0.5 * alpha * (1.0 - spinf)
      95           0 :           DO i_u = 1,atoms%n_u
      96           0 :              DO j = -3,3
      97           0 :                 DO k = -3,3
      98           0 :                    sum1 = sum1 + ABS(n_mmp_out(k,j,i_u,1) - n_mmp_in(k,j,i_u,1))
      99           0 :                    sum2 = sum2 + ABS(n_mmp_out(k,j,i_u,2) - n_mmp_in(k,j,i_u,2))
     100             : 
     101             :                    n_mmp(k,j,i_u,1) =       gam * n_mmp_out(k,j,i_u,1) + &
     102             :                                       (1.0-gam) * n_mmp_in (k,j,i_u,1) + &
     103             :                                             del * n_mmp_out(k,j,i_u,2) - &
     104           0 :                                             del * n_mmp_in (k,j,i_u,2)
     105             : 
     106             :                    n_mmp(k,j,i_u,2) =       gam * n_mmp_out(k,j,i_u,2) + &
     107             :                                       (1.0-gam) * n_mmp_in (k,j,i_u,2) + &
     108             :                                             del * n_mmp_out(k,j,i_u,1) - &
     109           0 :                                             del * n_mmp_in (k,j,i_u,1)
     110             :                 END DO
     111             :              END DO
     112             :           END DO
     113           0 :           WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 1 =',sum1
     114           0 :           WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 2 =',sum2
     115             :        ENDIF
     116           0 :        n_mmp_in = n_mmp
     117           0 :        DEALLOCATE (n_mmp)
     118             :     ELSE ! input%ldauLinMix
     119             : 
     120             :        ! only calculate distance
     121             : 
     122          13 :        sum1 = 0.0
     123          65 :        DO i_u = 1, atoms%n_u
     124         793 :           DO j = -3,3
     125        5512 :              DO k = -3,3
     126        2912 :                 sum1 = sum1 + ABS(n_mmp_out(k,j,i_u,1) - n_mmp_in(k,j,i_u,1))
     127             :              END DO
     128             :           END DO
     129             :        END DO
     130          13 :        IF (input%jspins.EQ.1) THEN
     131          13 :           WRITE (6,'(a16,f12.6)') 'n_mmp distance =',sum1
     132             :        ELSE
     133           0 :           sum2 = 0.0
     134           0 :           WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 1 =',sum1
     135           0 :           DO i_u = 1, atoms%n_u
     136           0 :              DO j = -3,3
     137           0 :                 DO k = -3,3
     138           0 :                    sum2 = sum2 + ABS(n_mmp_out(k,j,i_u,2) - n_mmp_in(k,j,i_u,2))
     139             :                 END DO
     140             :              END DO
     141             :           END DO
     142           0 :           DO j=-3,3
     143           0 :              WRITE(6,'(14f12.6)') (n_mmp_in(k,j,1,2),k=-3,3)
     144             :           END DO
     145           0 :           WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 2 =',sum2
     146           0 :           DO j=-3,3
     147           0 :              WRITE(6,'(14f12.6)') (n_mmp_out(k,j,1,2),k=-3,3)
     148             :           END DO
     149             :        END IF
     150             :     END IF ! input%ldauLinMix
     151             : 
     152             :   END SUBROUTINE u_mix
     153             : END MODULE m_umix

Generated by: LCOV version 1.13