LCOV - code coverage report
Current view: top level - optional - flipcdn.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 74 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.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_flipcdn
       8             : !     *******************************************************
       9             : !     this subroutine reads the charge density and flips the 
      10             : !     magnetic moment within the m.t.sphere for each atom 
      11             : !     according to the variable nflip. This variable is read in
      12             : !     the main program
      13             : !             nflip = -1 : flip spin in sphere
      14             : !             nflip = -2 : scale spin by bmu(n)
      15             : !             nflip = any: no spin flip
      16             : !                            r.pentcheva,kfa,Feb'96
      17             : !
      18             : !     Extension to multiple U per atom type by G.M. 2017
      19             : !     *******************************************************
      20             : CONTAINS
      21             : 
      22           0 : SUBROUTINE flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell)
      23             : 
      24             :    USE m_constants
      25             :    USE m_cdn_io
      26             :    USE m_types
      27             : 
      28             :    IMPLICIT NONE
      29             : 
      30             :    TYPE(t_stars),INTENT(IN)    :: stars
      31             :    TYPE(t_vacuum),INTENT(IN)   :: vacuum
      32             :    TYPE(t_atoms),INTENT(IN)    :: atoms
      33             :    TYPE(t_sphhar),INTENT(IN)   :: sphhar
      34             :    TYPE(t_input),INTENT(INOUT) :: input
      35             :    TYPE(t_sym),INTENT(IN)      :: sym
      36             :    TYPE(t_noco),INTENT(IN)     :: noco
      37             :    TYPE(t_oneD),INTENT(IN)     :: oneD
      38             :    TYPE(t_cell),INTENT(IN)     :: cell
      39             : 
      40             :    ! Local type instance
      41           0 :    TYPE(t_potden)            :: den
      42             : 
      43             :    ! Local Scalars
      44             :    REAL                      :: rhodummy,rhodumms,fermiEnergyTemp
      45             :    INTEGER                   :: i,nt,j,lh,na,mp,ispin,urec,itype,m,i_u
      46             :    INTEGER                   :: archiveType
      47             :    LOGICAL                   :: n_exist,l_qfix,l_error
      48             : 
      49             :    ! Local Arrays
      50           0 :    CHARACTER(len=80), ALLOCATABLE :: clines(:)
      51             : 
      52           0 :    CALL den%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
      53           0 :    IF(noco%l_noco) THEN
      54           0 :       archiveType = CDN_ARCHIVE_TYPE_NOCO_const
      55             :    ELSE
      56           0 :       archiveType = CDN_ARCHIVE_TYPE_CDN1_const
      57             :    END IF
      58             : 
      59             :    ! read the charge density 
      60             :    CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,&
      61           0 :                     CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den)
      62             : 
      63             :    ! flip cdn for each atom with nflip=-1
      64           0 :    na = 1
      65           0 :    DO itype = 1, atoms%ntype
      66           0 :       IF (atoms%nflip(itype).EQ.-1) THEN
      67             :          ! spherical and non-spherical m.t. charge density
      68           0 :          DO lh = 0,sphhar%nlh(atoms%ntypsy(na))
      69           0 :             DO j = 1,atoms%jri(itype)
      70           0 :                rhodummy = den%mt(j,lh,itype,1)
      71           0 :                den%mt(j,lh,itype,1) = den%mt(j,lh,itype,input%jspins)
      72           0 :                den%mt(j,lh,itype,input%jspins) = rhodummy
      73             :             END DO
      74             :          END DO
      75           0 :       ELSE IF (atoms%nflip(itype).EQ.-2) THEN
      76           0 :          DO lh = 0,sphhar%nlh(atoms%ntypsy(na))
      77           0 :             DO j = 1,atoms%jri(itype)
      78           0 :                rhodummy = den%mt(j,lh,itype,1) + den%mt(j,lh,itype,input%jspins)
      79           0 :                rhodumms = den%mt(j,lh,itype,1) - den%mt(j,lh,itype,input%jspins)
      80           0 :                den%mt(j,lh,itype,1) = 0.5 * (rhodummy + atoms%bmu(itype)*rhodumms)
      81           0 :                den%mt(j,lh,itype,input%jspins) = 0.5 * (rhodummy - atoms%bmu(itype)*rhodumms )
      82             :             END DO
      83             :          END DO
      84             :       END IF
      85           0 :          na = na + atoms%neq(itype)
      86             :    END DO
      87             : 
      88             :    ! for LDA+U: flip density matrix
      89           0 :    IF (ANY(den%mmpMat(:,:,:,:).NE.0.0).AND.atoms%n_u>0) THEN
      90           0 :       DO i_u = 1, atoms%n_u
      91           0 :          itype = atoms%lda_u(i_u)%atomType
      92           0 :          IF (atoms%nflip(itype).EQ.-1) THEN
      93           0 :             DO m = -3,3
      94           0 :                DO mp = -3,3
      95           0 :                   rhodummy = den%mmpMat(m,mp,i_u,1)
      96           0 :                   den%mmpMat(m,mp,i_u,1) = den%mmpMat(m,mp,i_u,input%jspins)
      97           0 :                   den%mmpMat(m,mp,i_u,input%jspins) = rhodummy
      98             :                END DO
      99             :             END DO
     100           0 :          ELSE IF (atoms%nflip(itype).EQ.-2) THEN
     101           0 :             DO m = -3,3
     102           0 :                DO mp = -3,3
     103           0 :                   rhodummy = den%mmpMat(m,mp,i_u,1) + den%mmpMat(m,mp,i_u,input%jspins)
     104           0 :                   rhodumms = den%mmpMat(m,mp,i_u,1) - den%mmpMat(m,mp,i_u,input%jspins)
     105           0 :                   den%mmpMat(m,mp,i_u,1) = 0.5 * (rhodummy + atoms%bmu(itype) * rhodumms)
     106           0 :                   den%mmpMat(m,mp,i_u,input%jspins) = 0.5 * (rhodummy - atoms%bmu(itype) * rhodumms)
     107             :                END DO
     108             :             END DO
     109             :          END IF
     110             :       END DO
     111             :    END IF
     112             : 
     113             :    ! write the spin-polarized density
     114             :    CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
     115           0 :                      0,-1.0,0.0,.FALSE.,den)
     116             : 
     117             :    ! read enpara and  flip lines
     118           0 :    INQUIRE(file='enpara',exist=n_exist)
     119           0 :    IF (n_exist) THEN
     120           0 :       OPEN(40,file ='enpara',status='old',form='formatted')
     121             : 
     122           0 :       j = 2
     123           0 :       DO itype = 1, atoms%ntype
     124           0 :          j = j + 1
     125           0 :          IF (atoms%nlo(itype)>0) j = j + 2
     126             :       END DO
     127           0 :       IF (input%film) j = j + 1
     128           0 :       ALLOCATE (clines(2*j))
     129           0 :       DO i = 1, 2*j
     130           0 :          READ (40,'(a)') clines(i)
     131             :       END DO
     132             : 
     133           0 :       REWIND 40
     134           0 :       i = 0 
     135           0 :       DO ispin = 1,input%jspins
     136           0 :          i = i + 2
     137           0 :          WRITE (40,'(a)') TRIM(clines(i-1))
     138           0 :          WRITE (40,'(a)') TRIM(clines(i))
     139           0 :          DO itype = 1, atoms%ntype
     140           0 :             i = i + 1
     141           0 :             m = i
     142           0 :             IF (atoms%nflip(itype)==-1) m = MOD(i+j,2*j)
     143           0 :             IF (m==0) m = 2*j
     144           0 :             WRITE (40,'(a)') TRIM(clines(m))
     145           0 :             IF (atoms%nlo(itype)>0) THEN
     146           0 :                WRITE (40,'(a)') TRIM(clines(m+1))
     147           0 :                WRITE (40,'(a)') TRIM(clines(m+2))
     148           0 :                i = i + 2
     149             :             END IF
     150             :          END DO
     151           0 :          IF (input%film) THEN
     152           0 :             i = i + 1
     153           0 :             WRITE (40,'(a)') TRIM(clines(i))
     154             :          END IF
     155             :       END DO
     156           0 :       DEALLOCATE (clines)
     157           0 :       CLOSE(40)
     158             :    END IF
     159             : 
     160           0 : END SUBROUTINE flipcdn
     161             : 
     162             : END MODULE m_flipcdn

Generated by: LCOV version 1.13