Line data    Source code

       1             :       MODULE m_ccsdnt
       2             : c...........................................................ccdnt
       3             : c charge and spin density calculations
       4             : c
       5             :       CONTAINS
       6          36 :       SUBROUTINE ccsdnt(
       7             :      >                  mrad,is,jtop,nsol,
       8          36 :      >                  l,xmj,kap1,kap2,gck,fck,rc2,
       9          36 :      <                  rhochr,rhospn)
      10             :       IMPLICIT NONE
      11             : C     ..
      12             : C     .. Scalar Arguments ..
      13             :       INTEGER, INTENT (IN) :: mrad
      14             :       REAL xmj
      15             :       INTEGER is,jtop,kap1,kap2,l,nsol
      16             : C     ..
      17             : C     .. Array Arguments ..
      18             :       REAL fck(2,2,mrad),gck(2,2,mrad),rc2(mrad)
      19             :       REAL, INTENT (OUT) :: rhochr(mrad),rhospn(mrad)
      20             : C     ..
      21             : C     .. Local Scalars ..
      22             :       REAL cg1,cg2,cg4,cg5,cg8,cgo
      23             :       INTEGER ir,k,n
      24             : C     ..
      25             : C     .. Local Arrays ..
      26             :       REAL cgd(2),cgmd(2)
      27             : C     ..
      28             : C     .. Intrinsic Functions ..
      29             :       INTRINSIC abs,sqrt
      30             : C     ..
      31       24264 :       DO ir = 1,mrad
      32       24228 :          rhochr(ir) = 0.0
      33       24264 :          rhospn(ir) = 0.0
      34             :       END DO
      35             : c                       -----------------------------------
      36             : c                       coeffisients for spin-density
      37             : c                       -----------------------------------
      38             : c      KAP1 = - L - 1
      39             : c      KAP2 = + L
      40          36 :       cg1 = -xmj/ (kap1+0.50)
      41          36 :       cg5 = -xmj/ (-kap1+0.50)
      42          36 :       cgd(1) = cg1
      43          36 :       cgmd(1) = cg5
      44          36 :       IF (abs(xmj).GT.l) THEN
      45          20 :          cg2 = 0.00
      46          20 :          cg4 = 0.00
      47          20 :          cg8 = 0.00
      48          20 :          cgd(2) = 0.00
      49          20 :          cgo = 0.00
      50          20 :          cgmd(2) = 0.00
      51             :       ELSE
      52          16 :          cg2 = -sqrt(1.0- (xmj/ (kap1+0.50))**2)
      53          16 :          cg4 = -xmj/ (kap2+0.50)
      54          16 :          cg8 = -xmj/ (-kap2+0.50)
      55          16 :          cgd(2) = cg4
      56          16 :          cgo = cg2
      57          16 :          cgmd(2) = cg8
      58             :       END IF
      59             : C
      60       24264 :       DO n = 1,jtop
      61       59260 :          DO k = 1,nsol
      62             :             rhochr(n) = rhochr(n) + rc2(n)*
      63       34996 :      +                  (gck(k,is,n)**2+fck(k,is,n)**2)
      64             :             rhospn(n) = rhospn(n) + rc2(n)*
      65             :      +                  (gck(k,is,n)*gck(k,is,n)*cgd(k)-
      66       59224 :      +                  fck(k,is,n)*fck(k,is,n)*cgmd(k))
      67             :          END DO
      68             :       END DO
      69             : c
      70          36 :       IF (nsol.GT.1) THEN
      71       10784 :          DO n = 1,jtop
      72             :             rhospn(n) = rhospn(n) + rc2(n)*
      73       10784 :      +                  (gck(1,is,n)*gck(2,is,n)*cgo*2.)
      74             :          END DO
      75             :       END IF
      76             : c
      77          36 :       END SUBROUTINE ccsdnt
      78             :       END MODULE m_ccsdnt