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

          Line data    Source code
       1             :       MODULE m_spratm
       2             : c------------------------------------------------------------------
       3             : c
       4             : c    This is the driver subroutine for a full-relativistic spin-polarized
       5             : c    core charge and spin density calculation using the 4 fold coupled
       6             : c    dirac equation : collection of references on this story see in
       7             : c    H. Ebert, J.Phys.: Condens. Matter 1 (1989) 9111.
       8             : c
       9             : c    Attention : The algorithm uses Ry-units. Therefore , potential
      10             : c                is multiplied by factor of 2 before it is used in the
      11             : c                dirac equation
      12             : c
      13             : c---> input:
      14             : c    Vr      =   spherical potential
      15             : c    Br      =   spherical magn. field
      16             : c    z       =   atomic charge
      17             : c    rnot    =   radial mesh starting point
      18             : c    dx      =   radial mesh logariphmic increment
      19             : c    jtop    =   upper bond for core radial mesh
      20             : c---> i/o
      21             : c    ectab   =   atomic energy levels for (\kappa,\mu) (in Hr)
      22             : c---> output
      23             : c    sume    =   sum of atomic eigenvalues (in Hr)
      24             : c    rhochr  =   core charge density
      25             : c    rhospn  =   core spin density
      26             : c
      27             : c........................................................ spratm
      28             :       CONTAINS
      29           0 :       SUBROUTINE spratm(
      30           0 :      >                  msh,vr,br,z,rnot,dx,jtop,ectab,ntab,ltab,
      31           0 :      <                  sume,rhochr,rhospn)
      32             : c
      33             :       USE m_core
      34             :       IMPLICIT NONE
      35             : c
      36             : C     .. Scalar Arguments ..
      37             :       INTEGER, INTENT (IN) :: msh,jtop
      38             :       REAL,    INTENT (IN) :: dx,rnot,z
      39             :       REAL,    INTENT (OUT):: sume
      40             : C     ..
      41             : C     .. Array Arguments ..
      42             :       INTEGER, INTENT (IN) :: ntab(100),ltab(100)
      43             :       REAL,    INTENT (IN) :: br(msh),vr(msh)
      44             :       REAL,    INTENT (OUT):: rhochr(msh),rhospn(msh)
      45             :       REAL,    INTENT (INOUT):: ectab(100)
      46             : C     ..
      47             : C     .. Local Scalars ..
      48             :       REAL rr,stval
      49             :       INTEGER ic,ir,nshell,n_old,l_old
      50             : C     ..
      51             : C     .. Local Arrays ..
      52           0 :       REAL bt(msh),vt(msh)
      53             :       INTEGER nqntab(15),lqntab(15)
      54             : C     ..
      55             : C     .. Intrinsic Functions ..
      56             :       INTRINSIC exp,log
      57             : C     ..
      58           0 :       nshell = 0
      59           0 :       ic = 0 ; n_old = -1 ; l_old = -1
      60           0 :       DO WHILE (ntab(ic+1).GT.0) 
      61           0 :         ic = ic + 1
      62           0 :         IF  (ntab(ic).NE.n_old) THEN
      63           0 :            nshell = nshell + 1
      64           0 :            nqntab(nshell) = ntab(ic)
      65           0 :            lqntab(nshell) = ltab(ic)
      66           0 :            n_old = ntab(ic)
      67           0 :            l_old = ltab(ic)
      68           0 :         ELSEIF (ltab(ic).NE.l_old) THEN
      69           0 :            nshell = nshell + 1
      70           0 :            nqntab(nshell) = ntab(ic)
      71           0 :            lqntab(nshell) = ltab(ic)
      72           0 :            n_old = ntab(ic)
      73           0 :            l_old = ltab(ic)
      74             :         ENDIF
      75             :       ENDDO
      76             : c Hr -> Ry
      77             :       ic = 0
      78           0 :       DO ic = 1,100
      79           0 :          ectab(ic) = 2.*ectab(ic)
      80             :       END DO
      81             : c potential and field redefinition
      82           0 :       rr = rnot
      83           0 :       DO ir = 1,msh
      84           0 :          vt(ir) = 2.*vr(ir)/rr
      85           0 :          bt(ir) = 2.*br(ir)/rr
      86           0 :          rr = rr*exp(dx)
      87             :       END DO
      88           0 :       stval = log(rnot)
      89             : c
      90             :       CALL core(
      91             :      >          msh,vt,bt,z,stval,dx,nshell,nqntab,lqntab,jtop,
      92             :      X          ectab,
      93           0 :      <          rhochr,rhospn)
      94             : 
      95             : c Ry -> Hr
      96           0 :       sume = 0.0
      97           0 :       DO ic = 1,100
      98           0 :          ectab(ic) = ectab(ic)/2.
      99           0 :          sume = sume + ectab(ic)
     100             :       END DO
     101             : 
     102           0 :       END SUBROUTINE spratm
     103             :       END MODULE m_spratm

Generated by: LCOV version 1.13