LCOV - code coverage report
Current view: top level - cdn_mt - cdncore.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 47 55 85.5 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2018 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_cdncore
       8             : 
       9             : CONTAINS
      10             : 
      11         324 : SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
      12             :                    stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen)
      13             : 
      14             :    USE m_constants
      15             :    USE m_judft
      16             :    USE m_cdn_io
      17             :    USE m_cdnovlp
      18             :    USE m_cored
      19             :    USE m_coredr
      20             :    USE m_types
      21             :    USE m_xmlOutput
      22             :    USE m_magMoms
      23             :    USE m_orbMagMoms
      24             : #ifdef CPP_MPI
      25             :    USE m_mpi_bc_coreden
      26             : #endif
      27             : 
      28             :    IMPLICIT NONE
      29             : 
      30             : 
      31             :    TYPE(t_mpi),        INTENT(IN)              :: mpi
      32             :    TYPE(t_dimension),  INTENT(IN)              :: dimension
      33             :    TYPE(t_oneD),       INTENT(IN)              :: oneD
      34             :    TYPE(t_input),      INTENT(IN)              :: input
      35             :    TYPE(t_vacuum),     INTENT(IN)              :: vacuum
      36             :    TYPE(t_noco),       INTENT(IN)              :: noco
      37             :    TYPE(t_sym),        INTENT(IN)              :: sym
      38             :    TYPE(t_stars),      INTENT(IN)              :: stars
      39             :    TYPE(t_cell),       INTENT(IN)              :: cell
      40             :    TYPE(t_sphhar),     INTENT(IN)              :: sphhar
      41             :    TYPE(t_atoms),      INTENT(IN)              :: atoms
      42             :    TYPE(t_potden),     INTENT(IN)              :: vTot
      43             :    TYPE(t_potden),     INTENT(INOUT)           :: outDen
      44             :    TYPE(t_moments),    INTENT(INOUT)           :: moments
      45             :    TYPE(t_results),    INTENT(INOUT)           :: results
      46             :    TYPE(t_potden),     INTENT(INOUT), OPTIONAL :: EnergyDen
      47             : 
      48             :    INTEGER                          :: jspin, n, iType
      49             :    REAL                             :: seig, rhoint, momint
      50             :    LOGICAL, PARAMETER               :: l_st=.FALSE.
      51             : 
      52         648 :    REAL                             :: rh(dimension%msh,atoms%ntype,input%jspins)
      53         648 :    REAL                             :: qint(atoms%ntype,input%jspins)
      54         648 :    REAL                             :: tec(atoms%ntype,input%jspins)
      55         648 :    REAL                             :: rhTemp(dimension%msh,atoms%ntype,input%jspins)
      56             : 
      57             : 
      58         324 :    results%seigc = 0.0
      59         324 :    IF (mpi%irank==0) THEN
      60         457 :       DO jspin = 1,input%jspins
      61        1583 :          DO n = 1,atoms%ntype
      62         858 :             moments%svdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
      63             :          END DO
      64             :       END DO
      65             :    END IF
      66             : 
      67         324 :    IF (input%kcrel==0) THEN
      68             :       ! Generate input file ecore for subsequent GW calculation
      69             :       ! 11.2.2004 Arno Schindlmayr
      70         324 :       IF ((input%gw==1 .or. input%gw==3).AND.(mpi%irank==0)) THEN
      71           0 :          OPEN (15,file='ecore',status='unknown', action='write',form='unformatted')
      72             :       END IF
      73             : 
      74         914 :       rh = 0.0
      75         914 :       tec = 0.0
      76         914 :       qint = 0.0
      77         324 :       IF (input%frcor) THEN
      78           0 :          IF (mpi%irank==0) THEN
      79           0 :             CALL readCoreDensity(input,atoms,dimension,rh,tec,qint)
      80             :          END IF
      81             : #ifdef CPP_MPI
      82           0 :          CALL mpi_bc_coreDen(mpi,atoms,input,dimension,rh,tec,qint)
      83             : #endif
      84             :       END IF
      85             :    END IF
      86             : 
      87             :    !add in core density
      88         324 :    IF (mpi%irank==0) THEN
      89         162 :       IF (input%kcrel==0) THEN
      90         457 :          DO jspin = 1,input%jspins
      91         295 :             IF(PRESENT(EnergyDen)) THEN
      92           0 :                CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig, EnergyDen%mt)
      93             :             ELSE
      94         295 :                CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh ,tec,seig)
      95             :             ENDIF
      96             : 
      97         295 :             rhTemp(:,:,jspin) = rh(:,:,jspin)
      98         457 :             results%seigc = results%seigc + seig
      99             :          END DO
     100             :       ELSE
     101           0 :          IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for relativistic core calculations")
     102           0 :          CALL coredr(input,atoms,seig, outDen%mt,dimension,sphhar,vTot%mt(:,0,:,:),qint,rh)
     103           0 :          results%seigc = results%seigc + seig
     104             :       END IF
     105             :    END IF
     106         914 :    DO jspin = 1,input%jspins
     107         590 :       IF (mpi%irank==0) THEN
     108         858 :          DO n = 1,atoms%ntype
     109         858 :             moments%stdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
     110             :          END DO
     111             :       END IF
     112         914 :       IF ((noco%l_noco).AND.(mpi%irank==0)) THEN
     113         248 :          IF (jspin==2) THEN
     114             : 
     115         124 :             IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for noco")
     116             :             !pk non-collinear (start)
     117             :             !add the coretail-charge to the constant interstitial
     118             :             !charge (star 0), taking into account the direction of
     119             :             !magnetisation of this atom
     120         352 :             DO iType = 1,atoms%ntype
     121         228 :                rhoint = (qint(iType,1) + qint(iType,2)) /(cell%volint * input%jspins * 2.0)
     122         228 :                momint = (qint(iType,1) - qint(iType,2)) /(cell%volint * input%jspins * 2.0)
     123             :                !rho_11
     124         228 :                outDen%pw(1,1) = outDen%pw(1,1) + rhoint + momint*cos(noco%beta(iType))
     125             :                !rho_22
     126         228 :                outDen%pw(1,2) = outDen%pw(1,2) + rhoint - momint*cos(noco%beta(iType))
     127             :                !real part rho_21
     128             :                outDen%pw(1,3) = outDen%pw(1,3) + cmplx( 0.5*momint *cos(noco%alph(iType))*sin(noco%beta(iType)),&
     129             :                !imaginary part rho_21
     130         352 :                                                        -0.5*momint *sin(noco%alph(iType))*sin(noco%beta(iType)))
     131             :             END DO
     132             :             !pk non-collinear (end)
     133             :          END IF
     134             :       ELSE
     135         342 :          IF (input%ctail) THEN
     136          90 :             IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for ctail")
     137             :             !+gu hope this works as well
     138             :             CALL cdnovlp(mpi,sphhar,stars,atoms,sym,dimension,vacuum,&
     139             :                          cell,input,oneD,l_st,jspin,rh(:,:,jspin),&
     140          90 :                          outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz)
     141         252 :          ELSE IF (mpi%irank==0) THEN
     142           4 :             DO iType = 1,atoms%ntype
     143           2 :                outDen%pw(1,jspin) = outDen%pw(1,jspin) + qint(iType,jspin) / (input%jspins * cell%volint)
     144             :             END DO
     145             :          END IF
     146             :       END IF
     147             :    END DO
     148             : 
     149         324 :    IF (input%kcrel==0) THEN
     150         324 :       IF (mpi%irank==0) THEN
     151         162 :          CALL writeCoreDensity(input,atoms,dimension,rhTemp,tec,qint)
     152             :       END IF
     153         324 :       IF ((input%gw==1 .or. input%gw==3).AND.(mpi%irank==0)) CLOSE(15)
     154             :    END IF
     155             : 
     156         324 : END SUBROUTINE cdncore
     157             : 
     158             : END MODULE m_cdncore

Generated by: LCOV version 1.13