LCOV - code coverage report
Current view: top level - core - ccdnup.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 36 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : MODULE m_ccdnup
       2             :   !     *******************************************************
       3             :   !     *****   set up the core densities for compounds.  *****
       4             :   !     *****   in accordanse to d.d.koelling's cored     *****
       5             :   !     *******************************************************
       6             : CONTAINS
       7           0 :   SUBROUTINE ccdnup(&
       8             :        &                  atoms,sphhar,input,jatom,&
       9           0 :        &                  rho,&
      10           0 :        &                  sume,vrs,rhochr,rhospn,&
      11           0 :        &                  tecs,qints)
      12             : 
      13             :     USE m_constants,ONLY:sfp_const
      14             :     USE m_intgr, ONLY : intgr3
      15             :     USE m_types
      16             :     IMPLICIT NONE
      17             :     TYPE(t_input),INTENT(IN)   :: input
      18             :     TYPE(t_sphhar),INTENT(IN)  :: sphhar
      19             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      20             :     !     ..
      21             :     !     .. Scalar Arguments ..
      22             :     INTEGER, INTENT (IN) :: jatom 
      23             :     REAL,    INTENT (IN) :: sume
      24             :     !     ..
      25             :     !     .. Array Arguments ..
      26             :     REAL,    INTENT (IN) :: rhochr(:),rhospn(:)!(dimension%msh)
      27             :     REAL,    INTENT (IN) :: vrs(:,:,:)!(atoms%jmtd,atoms%ntype,input%jspins)
      28             :     REAL,    INTENT (OUT) :: tecs(:,:)!(atoms%ntype,input%jspins)
      29             :     REAL,    INTENT (OUT) :: qints(:,:)!(atoms%ntype,input%jspins)
      30             :     REAL,    INTENT (INOUT) :: rho(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
      31             :     !     ..
      32             :     !     .. Local Scalars ..
      33             :     REAL d,dxx,q,rad,rhs
      34             :     INTEGER i,j,jspin,nm,nm1
      35             :     !     ..
      36             :     !     .. Local Arrays ..
      37           0 :     REAL rhoc(SIZE(rhochr)),rhoss(SIZE(rhochr))
      38             :     !     ..
      39           0 :     nm = atoms%jri(jatom)
      40             :     !     ---->update spherical charge density rho with the core density.
      41             :     !     ---->for spin-polarized (jspins=2), take only half the density
      42           0 :     DO jspin = 1,input%jspins
      43           0 :        IF (input%jspins.EQ.2 .AND. jspin.EQ.1) THEN
      44           0 :           DO j = 1,SIZE(rhochr)
      45           0 :              rhoss(j) = rhochr(j) - rhospn(j)
      46             :           END DO
      47           0 :        ELSE IF (input%jspins.EQ.2 .AND. jspin.EQ.2) THEN
      48           0 :           DO j = 1,SIZE(rhochr)
      49           0 :              rhoss(j) = rhochr(j) + rhospn(j)
      50             :           END DO
      51             :           ! jspins=1
      52             :        ELSE
      53           0 :           DO j = 1,SIZE(rhochr)
      54           0 :              rhoss(j) = rhochr(j)
      55             :           END DO
      56             :           !
      57             :        END IF
      58             :        !
      59           0 :        DO  j = 1,nm
      60           0 :           rhoc(j) = rhoss(j)/input%jspins
      61           0 :           rho(j,0,jatom,jspin) = rho(j,0,jatom,jspin) + rhoc(j)/sfp_const
      62             :        ENDDO
      63           0 :        DO  i = 1,nm
      64           0 :           rhoc(i) = rhoc(i)*vrs(i,jatom,jspin)/atoms%rmsh(i,jatom)
      65             :        ENDDO
      66           0 :        CALL intgr3(rhoc,atoms%rmsh(1,jatom),atoms%dx(jatom),nm,rhs)
      67           0 :        tecs(jatom,jspin) = sume/input%jspins - rhs
      68           0 :        WRITE (6,FMT=8010) jatom,jspin,tecs(jatom,jspin),sume/input%jspins
      69             :   
      70             :        !     ---> simpson integration
      71           0 :        dxx = atoms%dx(jatom)
      72           0 :        d = EXP(atoms%dx(jatom))
      73           0 :        rad = atoms%rmt(jatom)
      74           0 :        q = rad*rhoss(nm)/2.
      75           0 :        DO  nm1 = nm + 1,SIZE(rhochr) - 1,2
      76           0 :           rad = d*rad
      77           0 :           q = q + 2*rad*rhoss(nm1)
      78           0 :           rad = d*rad
      79           0 :           q = q + rad*rhoss(nm1+1)
      80             :        ENDDO
      81           0 :        q = 2*q*dxx/3
      82           0 :        WRITE (6,FMT=8000) q/input%jspins
      83           0 :        qints(jatom,jspin) = q*atoms%neq(jatom)
      84             : 
      85             :     END DO ! end-do-loop input%jspins
      86             : 
      87             : 8000 FORMAT (f20.8,' electrons lost from core.')
      88             : 8010 FORMAT (10x,'atom type',i3,'  (spin',i2,') ',/,10x,&
      89             :          &       'kinetic energy=',e20.12,5x,'sum of the eigenvalues=',&
      90             :          &       e20.12)
      91             : 
      92           0 :   END SUBROUTINE ccdnup
      93             : END MODULE m_ccdnup

Generated by: LCOV version 1.13