LCOV - code coverage report
Current view: top level - ldau - u_setup.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 40 41 97.6 %
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_usetup
       8             :   USE m_juDFT
       9             :   !-------------------------------------------------------------------+
      10             :   ! Sets up the quantities needed for the LDA+U subroutines:          |
      11             :   !     radial integrals: us,dus,uds,duds                             |
      12             :   !     overlap of dot u: ddn                                         |
      13             :   !     potential matrix: vs_mmp                                      |
      14             :   !     total energy contribution: e_ldau                             |
      15             :   !                                                  G.B. Oct. 2000   |
      16             :   !                                                                   |
      17             :   !     Extension to multiple U per atom type  G.M. 2017              |
      18             :   !-------------------------------------------------------------------+
      19             : CONTAINS
      20          30 :   SUBROUTINE u_setup(sym,atoms,sphhar, input,el,inDen,pot,mpi,results)
      21             :     USE m_umtx
      22             :     USE m_uj2f
      23             :     USE m_nmat_rot
      24             :     USE m_vmmp
      25             :     USE m_types
      26             :     USE m_constants
      27             :     USE m_cdn_io
      28             :     IMPLICIT NONE
      29             :     TYPE(t_sym),INTENT(IN)          :: sym
      30             :     TYPE(t_results),INTENT(INOUT)   :: results
      31             :     TYPE(t_mpi),INTENT(IN)          :: mpi
      32             :     TYPE(t_input),INTENT(IN)        :: input
      33             :     TYPE(t_sphhar),INTENT(IN)       :: sphhar
      34             :     TYPE(t_atoms),INTENT(IN)        :: atoms
      35             :     TYPE(t_potden),INTENT(IN)       :: inDen
      36             :     TYPE(t_potden),INTENT(INOUT)    :: pot
      37             : 
      38             :     REAL,    INTENT(IN)           :: el(0:,:,:) !(0:atoms%lmaxd,ntype,jspd)
      39             :     ! ... Local Variables ...
      40             :     INTEGER itype,ispin,j,k,l,jspin,urec,i_u
      41             :     INTEGER noded,nodeu,ios
      42             :     REAL wronk
      43             :     CHARACTER*8 l_type*2,l_form*9
      44          60 :     REAL f(atoms%jmtd,2),g(atoms%jmtd,2),zero(atoms%n_u)
      45          60 :     REAL f0(atoms%n_u,input%jspins),f2(atoms%n_u,input%jspins),f4(atoms%n_u,input%jspins),f6(atoms%n_u,input%jspins)
      46          30 :     REAL, ALLOCATABLE :: u(:,:,:,:,:,:)
      47          30 :     COMPLEX, ALLOCATABLE :: n_mmp(:,:,:,:)
      48             :     !
      49             :     ! look, whether density matrix exists already:
      50             :     !
      51          30 :     IF (ANY(inDen%mmpMat(:,:,:,:).NE.0.0).AND.atoms%n_u>0) THEN
      52             : 
      53             :        ! calculate slater integrals from u and j
      54          28 :        CALL uj2f(input%jspins,atoms,f0,f2,f4,f6)
      55             : 
      56             :        ! set up e-e- interaction matrix
      57             :        ALLOCATE (u(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,&
      58          28 :                    -lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
      59          28 :        ALLOCATE (n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
      60          28 :        n_mmp(:,:,:,:) = inDen%mmpMat(:,:,:,:)
      61          56 :        DO ispin = 1, 1 ! input%jspins
      62          28 :           f0(:,1) = (f0(:,1) + f0(:,input%jspins) ) / 2
      63         140 :           f2(:,1) = (f2(:,1) + f2(:,input%jspins) ) / 2
      64         140 :           f4(:,1) = (f4(:,1) + f4(:,input%jspins) ) / 2
      65         140 :           f6(:,1) = (f6(:,1) + f6(:,input%jspins) ) / 2
      66             :           CALL umtx(atoms,f0(1,ispin),f2(1,ispin),f4(1,ispin),f6(1,ispin),&
      67          56 :                     u(-lmaxU_const,-lmaxU_const,-lmaxU_const,-lmaxU_const,1,ispin))
      68             :        END DO
      69             : 
      70             :        ! check for possible rotation of n_mmp
      71         140 :        zero = 0.0
      72          28 :        CALL nmat_rot(atoms%lda_u(:)%phi,Atoms%lda_u(:)%theta,zero,3,atoms%n_u,input%jspins,atoms%lda_u%l,n_mmp)
      73             :        
      74             :        ! calculate potential matrix and total energy correction
      75          28 :        CALL v_mmp(sym,atoms,input%jspins,n_mmp,u,f0,f2,pot%mmpMat,results)
      76             : 
      77          28 :        IF (mpi%irank.EQ.0) THEN
      78          28 :           DO jspin = 1,input%jspins
      79          14 :              WRITE (6,'(a7,i3)') 'spin #',jspin
      80          84 :              DO i_u = 1, atoms%n_u
      81          56 :                 itype = atoms%lda_u(i_u)%atomType
      82          56 :                 l = atoms%lda_u(i_u)%l
      83          56 :                 WRITE (l_type,'(i2)') 2*(2*l+1)
      84          56 :                 l_form = '('//l_type//'f12.7)'
      85          56 :                 WRITE (6,'(a20,i3)') 'n-matrix for atom # ',itype
      86          56 :                 WRITE (6,l_form) ((n_mmp(k,j,i_u,jspin),k=-l,l),j=-l,l)
      87          56 :                 WRITE (6,'(a20,i3)') 'V-matrix for atom # ',itype
      88          56 :                 IF (atoms%lda_u(i_u)%l_amf) THEN
      89           0 :                    WRITE (6,*) 'using the around-mean-field limit '
      90             :                 ELSE
      91          56 :                    WRITE (6,*) 'using the atomic limit of LDA+U '
      92             :                 ENDIF
      93          70 :                 WRITE (6,l_form) ((pot%mmpMat(k,j,i_u,jspin),k=-l,l),j=-l,l)
      94             :              END DO
      95             :           END DO
      96          14 :           WRITE (6,*) results%e_ldau
      97             :        ENDIF
      98          28 :        DEALLOCATE (u,n_mmp)
      99             :     ELSE
     100           2 :        IF (mpi%irank.EQ.0) THEN
     101           1 :           WRITE (*,*) 'no density matrix found ... skipping LDA+U'
     102             :        ENDIF
     103           2 :        pot%mmpMat(:,:,:,:) = CMPLX(0.0,0.0)
     104           2 :        results%e_ldau = 0.0
     105             :     ENDIF
     106             : 
     107          30 :     RETURN
     108             :   END SUBROUTINE u_setup
     109             : END MODULE m_usetup

Generated by: LCOV version 1.13