Line data    Source code

       1             : MODULE m_corehff
       2             : 
       3             :    CONTAINS
       4             : 
       5          36 :    SUBROUTINE corehff(mrad,kap1,kap2,xmj,s,nsol,bhf,gck,fck,rc,dx,jtop)
       6             : !   ********************************************************************
       7             : !   *                                                                  *
       8             : !   *   CALCULATE THE RELATIVISTIC HYPERFINE FIELDS FOR THE            *
       9             : !   *                  CURRENT  CORE STATE S                           *
      10             : !   *                                                                  *
      11             : !   *   THE WAVE FUNCTION  {G(K,S),F(K,S)}  IS NORMALIZED TO 1         *
      12             : !   *                                                                  *
      13             : !   ********************************************************************
      14             : 
      15             :       USE m_constants
      16             :       USE m_rsimp
      17             : 
      18             :       IMPLICIT NONE
      19             : ! CONVERSION FACTOR FOR HYPERFINE FIELDS FROM A.U. TO GAUSS
      20             : !                                      ELECTRON CHARGE     IN ESU
      21             : !                                      BOHR-RADIUS         IN CM
      22             : !
      23             : !
      24             : ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      25             : !   ANGULAR HYPERFINE MATRIX ELEMENTS   SEE E.G.  E.M.ROSE
      26             : !        THE FACTOR  I  HAS BEEN OMITTED
      27             : 
      28             :       INTEGER, INTENT (IN) :: mrad
      29             :       INTEGER, INTENT (IN) :: jtop,kap1,kap2,nsol,s
      30             :       REAL, INTENT (OUT)   :: bhf
      31             :       REAL, INTENT (IN)    :: dx,xmj
      32             :       REAL, INTENT (IN)    :: fck(2,2,mrad),gck(2,2,mrad),rc(mrad)
      33             : 
      34             :       INTEGER n
      35             : 
      36             :       REAL e0, a0, cautog
      37          36 :       REAL ame(2,2),rint(mrad)
      38             :       
      39          36 :       a0 = bohr_to_angstrom_const * 1.0e-8
      40          36 :       e0 = 1.6021892e-19 * 2.997930e+09
      41          36 :       cautog = e0 / (a0*a0)
      42             : 
      43          36 :       ame(1,1) = 4.0*kap1*xmj/ (4.0*kap1*kap1-1.0)
      44          36 :       IF (nsol.EQ.2) THEN
      45          16 :          ame(2,2) = 4.0*kap2*xmj/ (4.0*kap2*kap2-1.0)
      46          16 :          ame(2,1) = sqrt(0.25- (xmj/real(kap1-kap2))**2)
      47          16 :          ame(1,2) = ame(2,1)
      48             :       END IF
      49             : ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      50          36 :       IF (nsol.EQ.1) THEN
      51       13480 :          DO n = 1,jtop
      52       13480 :             rint(n) = (gck(1,s,n)*fck(1,s,n)+fck(1,s,n)*gck(1,s,n)) * ame(1,1)
      53             :          END DO
      54             :       ELSE
      55       10784 :          DO n = 1,jtop
      56             :             rint(n) = (gck(1,s,n)*fck(1,s,n)+fck(1,s,n)*gck(1,s,n)) * ame(1,1) + &
      57             :                       (gck(2,s,n)*fck(2,s,n)+fck(2,s,n)*gck(2,s,n)) * ame(2,2) + &
      58             :                       (gck(2,s,n)*fck(1,s,n)+fck(2,s,n)*gck(1,s,n)) * ame(2,1) + &
      59       10784 :                       (gck(1,s,n)*fck(2,s,n)+fck(1,s,n)*gck(2,s,n)) * ame(1,2)
      60             :          END DO
      61             :       END IF
      62          36 :       bhf = -cautog*rsimp(mrad,rint,rc,jtop,dx)*0.001
      63             : !      write(oUnit,'(''hf='',e14.7)') BHF
      64             : 
      65          36 :    END SUBROUTINE corehff
      66             :       
      67             : END MODULE m_corehff