Line data    Source code

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